Index: /TOOLS/MOZAIC/Doxyfile
===================================================================
--- /TOOLS/MOZAIC/Doxyfile	(revision 3326)
+++ /TOOLS/MOZAIC/Doxyfile	(revision 3326)
@@ -0,0 +1,1551 @@
+# Doxyfile 1.6.3
+
+# This file describes the settings to be used by the documentation system
+# doxygen (www.doxygen.org) for a project
+#
+# All text after a hash (#) is considered a comment and will be ignored
+# The format is:
+#       TAG = value [value, ...]
+# For lists items can also be appended using:
+#       TAG += value [value, ...]
+# Values that contain spaces should be placed between quotes (" ")
+
+#---------------------------------------------------------------------------
+# Project related configuration options
+#---------------------------------------------------------------------------
+
+# This tag specifies the encoding used for all characters in the config file
+# that follow. The default is UTF-8 which is also the encoding used for all
+# text before the first occurrence of this tag. Doxygen uses libiconv (or the
+# iconv built into libc) for the transcoding. See
+# http://www.gnu.org/software/libiconv for the list of possible encodings.
+
+DOXYFILE_ENCODING      = UTF-8
+
+# The PROJECT_NAME tag is a single word (or a sequence of words surrounded
+# by quotes) that should identify the project.
+
+PROJECT_NAME           = Mozaic
+
+# The PROJECT_NUMBER tag can be used to enter a project or revision number.
+# This could be handy for archiving the generated documentation or
+# if some version control system is used.
+
+PROJECT_NUMBER         = 
+
+# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute)
+# base path where the generated documentation will be put.
+# If a relative path is entered, it will be relative to the location
+# where doxygen was started. If left blank the current directory will be used.
+
+OUTPUT_DIRECTORY       = /Users/marti/Sites/Mozaic
+
+# If the CREATE_SUBDIRS tag is set to YES, then doxygen will create
+# 4096 sub-directories (in 2 levels) under the output directory of each output
+# format and will distribute the generated files over these directories.
+# Enabling this option can be useful when feeding doxygen a huge amount of
+# source files, where putting all generated files in the same directory would
+# otherwise cause performance problems for the file system.
+
+CREATE_SUBDIRS         = NO
+
+# The OUTPUT_LANGUAGE tag is used to specify the language in which all
+# documentation generated by doxygen is written. Doxygen will use this
+# information to generate all constant output in the proper language.
+# The default language is English, other supported languages are:
+# Afrikaans, Arabic, Brazilian, Catalan, Chinese, Chinese-Traditional,
+# Croatian, Czech, Danish, Dutch, Esperanto, Farsi, Finnish, French, German,
+# Greek, Hungarian, Italian, Japanese, Japanese-en (Japanese with English
+# messages), Korean, Korean-en, Lithuanian, Norwegian, Macedonian, Persian,
+# Polish, Portuguese, Romanian, Russian, Serbian, Serbian-Cyrilic, Slovak,
+# Slovene, Spanish, Swedish, Ukrainian, and Vietnamese.
+
+OUTPUT_LANGUAGE        = English
+
+# If the BRIEF_MEMBER_DESC tag is set to YES (the default) Doxygen will
+# include brief member descriptions after the members that are listed in
+# the file and class documentation (similar to JavaDoc).
+# Set to NO to disable this.
+
+BRIEF_MEMBER_DESC      = YES
+
+# If the REPEAT_BRIEF tag is set to YES (the default) Doxygen will prepend
+# the brief description of a member or function before the detailed description.
+# Note: if both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the
+# brief descriptions will be completely suppressed.
+
+REPEAT_BRIEF           = YES
+
+# This tag implements a quasi-intelligent brief description abbreviator
+# that is used to form the text in various listings. Each string
+# in this list, if found as the leading text of the brief description, will be
+# stripped from the text and the result after processing the whole list, is
+# used as the annotated text. Otherwise, the brief description is used as-is.
+# If left blank, the following values are used ("$name" is automatically
+# replaced with the name of the entity): "The $name class" "The $name widget"
+# "The $name file" "is" "provides" "specifies" "contains"
+# "represents" "a" "an" "the"
+
+ABBREVIATE_BRIEF       =
+
+# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then
+# Doxygen will generate a detailed section even if there is only a brief
+# description.
+
+ALWAYS_DETAILED_SEC    = NO
+
+# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all
+# inherited members of a class in the documentation of that class as if those
+# members were ordinary class members. Constructors, destructors and assignment
+# operators of the base classes will not be shown.
+
+INLINE_INHERITED_MEMB  = NO
+
+# If the FULL_PATH_NAMES tag is set to YES then Doxygen will prepend the full
+# path before files name in the file list and in the header files. If set
+# to NO the shortest path that makes the file name unique will be used.
+
+FULL_PATH_NAMES        = YES
+
+# If the FULL_PATH_NAMES tag is set to YES then the STRIP_FROM_PATH tag
+# can be used to strip a user-defined part of the path. Stripping is
+# only done if one of the specified strings matches the left-hand part of
+# the path. The tag can be used to show relative paths in the file list.
+# If left blank the directory from which doxygen is run is used as the
+# path to strip.
+
+STRIP_FROM_PATH        =
+
+# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of
+# the path mentioned in the documentation of a class, which tells
+# the reader which header file to include in order to use a class.
+# If left blank only the name of the header file containing the class
+# definition is used. Otherwise one should specify the include paths that
+# are normally passed to the compiler using the -I flag.
+
+STRIP_FROM_INC_PATH    =
+
+# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter
+# (but less readable) file names. This can be useful is your file systems
+# doesn't support long names like on DOS, Mac, or CD-ROM.
+
+SHORT_NAMES            = NO
+
+# If the JAVADOC_AUTOBRIEF tag is set to YES then Doxygen
+# will interpret the first line (until the first dot) of a JavaDoc-style
+# comment as the brief description. If set to NO, the JavaDoc
+# comments will behave just like regular Qt-style comments
+# (thus requiring an explicit @brief command for a brief description.)
+
+JAVADOC_AUTOBRIEF      = NO
+
+# If the QT_AUTOBRIEF tag is set to YES then Doxygen will
+# interpret the first line (until the first dot) of a Qt-style
+# comment as the brief description. If set to NO, the comments
+# will behave just like regular Qt-style comments (thus requiring
+# an explicit \brief command for a brief description.)
+
+QT_AUTOBRIEF           = NO
+
+# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make Doxygen
+# treat a multi-line C++ special comment block (i.e. a block of //! or ///
+# comments) as a brief description. This used to be the default behaviour.
+# The new default is to treat a multi-line C++ comment block as a detailed
+# description. Set this tag to YES if you prefer the old behaviour instead.
+
+MULTILINE_CPP_IS_BRIEF = NO
+
+# If the INHERIT_DOCS tag is set to YES (the default) then an undocumented
+# member inherits the documentation from any documented member that it
+# re-implements.
+
+INHERIT_DOCS           = YES
+
+# If the SEPARATE_MEMBER_PAGES tag is set to YES, then doxygen will produce
+# a new page for each member. If set to NO, the documentation of a member will
+# be part of the file/class/namespace that contains it.
+
+SEPARATE_MEMBER_PAGES  = NO
+
+# The TAB_SIZE tag can be used to set the number of spaces in a tab.
+# Doxygen uses this value to replace tabs by spaces in code fragments.
+
+TAB_SIZE               = 8
+
+# This tag can be used to specify a number of aliases that acts
+# as commands in the documentation. An alias has the form "name=value".
+# For example adding "sideeffect=\par Side Effects:\n" will allow you to
+# put the command \sideeffect (or @sideeffect) in the documentation, which
+# will result in a user-defined paragraph with heading "Side Effects:".
+# You can put \n's in the value part of an alias to insert newlines.
+
+ALIASES                =
+
+# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C
+# sources only. Doxygen will then generate output that is more tailored for C.
+# For instance, some of the names that are used will be different. The list
+# of all members will be omitted, etc.
+
+OPTIMIZE_OUTPUT_FOR_C  = NO
+
+# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java
+# sources only. Doxygen will then generate output that is more tailored for
+# Java. For instance, namespaces will be presented as packages, qualified
+# scopes will look different, etc.
+
+OPTIMIZE_OUTPUT_JAVA   = NO
+
+# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran
+# sources only. Doxygen will then generate output that is more tailored for
+# Fortran.
+
+OPTIMIZE_FOR_FORTRAN   = YES
+
+# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL
+# sources. Doxygen will then generate output that is tailored for
+# VHDL.
+
+OPTIMIZE_OUTPUT_VHDL   = NO
+
+# Doxygen selects the parser to use depending on the extension of the files it parses.
+# With this tag you can assign which parser to use for a given extension.
+# Doxygen has a built-in mapping, but you can override or extend it using this tag.
+# The format is ext=language, where ext is a file extension, and language is one of
+# the parsers supported by doxygen: IDL, Java, Javascript, C#, C, C++, D, PHP,
+# Objective-C, Python, Fortran, VHDL, C, C++. For instance to make doxygen treat
+# .inc files as Fortran files (default is PHP), and .f files as C (default is Fortran),
+# use: inc=Fortran f=C. Note that for custom extensions you also need to set FILE_PATTERNS otherwise the files are not read by doxygen.
+
+EXTENSION_MAPPING      = f90=Fortran f=Fortran F=Fortran F90=Fortran
+
+# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want
+# to include (a tag file for) the STL sources as input, then you should
+# set this tag to YES in order to let doxygen match functions declarations and
+# definitions whose arguments contain STL classes (e.g. func(std::string); v.s.
+# func(std::string) {}). This also make the inheritance and collaboration
+# diagrams that involve STL classes more complete and accurate.
+
+BUILTIN_STL_SUPPORT    = NO
+
+# If you use Microsoft's C++/CLI language, you should set this option to YES to
+# enable parsing support.
+
+CPP_CLI_SUPPORT        = NO
+
+# Set the SIP_SUPPORT tag to YES if your project consists of sip sources only.
+# Doxygen will parse them like normal C++ but will assume all classes use public
+# instead of private inheritance when no explicit protection keyword is present.
+
+SIP_SUPPORT            = NO
+
+# For Microsoft's IDL there are propget and propput attributes to indicate getter
+# and setter methods for a property. Setting this option to YES (the default)
+# will make doxygen to replace the get and set methods by a property in the
+# documentation. This will only work if the methods are indeed getting or
+# setting a simple type. If this is not the case, or you want to show the
+# methods anyway, you should set this option to NO.
+
+IDL_PROPERTY_SUPPORT   = YES
+
+# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC
+# tag is set to YES, then doxygen will reuse the documentation of the first
+# member in the group (if any) for the other members of the group. By default
+# all members of a group must be documented explicitly.
+
+DISTRIBUTE_GROUP_DOC   = NO
+
+# Set the SUBGROUPING tag to YES (the default) to allow class member groups of
+# the same type (for instance a group of public functions) to be put as a
+# subgroup of that type (e.g. under the Public Functions section). Set it to
+# NO to prevent subgrouping. Alternatively, this can be done per class using
+# the \nosubgrouping command.
+
+SUBGROUPING            = YES
+
+# When TYPEDEF_HIDES_STRUCT is enabled, a typedef of a struct, union, or enum
+# is documented as struct, union, or enum with the name of the typedef. So
+# typedef struct TypeS {} TypeT, will appear in the documentation as a struct
+# with name TypeT. When disabled the typedef will appear as a member of a file,
+# namespace, or class. And the struct will be named TypeS. This can typically
+# be useful for C code in case the coding convention dictates that all compound
+# types are typedef'ed and only the typedef is referenced, never the tag name.
+
+TYPEDEF_HIDES_STRUCT   = NO
+
+# The SYMBOL_CACHE_SIZE determines the size of the internal cache use to
+# determine which symbols to keep in memory and which to flush to disk.
+# When the cache is full, less often used symbols will be written to disk.
+# For small to medium size projects (<1000 input files) the default value is
+# probably good enough. For larger projects a too small cache size can cause
+# doxygen to be busy swapping symbols to and from disk most of the time
+# causing a significant performance penality.
+# If the system has enough physical memory increasing the cache will improve the
+# performance by keeping more symbols in memory. Note that the value works on
+# a logarithmic scale so increasing the size by one will rougly double the
+# memory usage. The cache size is given by this formula:
+# 2^(16+SYMBOL_CACHE_SIZE). The valid range is 0..9, the default is 0,
+# corresponding to a cache size of 2^16 = 65536 symbols
+
+SYMBOL_CACHE_SIZE      = 0
+
+#---------------------------------------------------------------------------
+# Build related configuration options
+#---------------------------------------------------------------------------
+
+# If the EXTRACT_ALL tag is set to YES doxygen will assume all entities in
+# documentation are documented, even if no documentation was available.
+# Private class members and static file members will be hidden unless
+# the EXTRACT_PRIVATE and EXTRACT_STATIC tags are set to YES
+
+EXTRACT_ALL            = NO
+
+# If the EXTRACT_PRIVATE tag is set to YES all private members of a class
+# will be included in the documentation.
+
+EXTRACT_PRIVATE        = NO
+
+# If the EXTRACT_STATIC tag is set to YES all static members of a file
+# will be included in the documentation.
+
+EXTRACT_STATIC         = NO
+
+# If the EXTRACT_LOCAL_CLASSES tag is set to YES classes (and structs)
+# defined locally in source files will be included in the documentation.
+# If set to NO only classes defined in header files are included.
+
+EXTRACT_LOCAL_CLASSES  = YES
+
+# This flag is only useful for Objective-C code. When set to YES local
+# methods, which are defined in the implementation section but not in
+# the interface are included in the documentation.
+# If set to NO (the default) only methods in the interface are included.
+
+EXTRACT_LOCAL_METHODS  = NO
+
+# If this flag is set to YES, the members of anonymous namespaces will be
+# extracted and appear in the documentation as a namespace called
+# 'anonymous_namespace{file}', where file will be replaced with the base
+# name of the file that contains the anonymous namespace. By default
+# anonymous namespace are hidden.
+
+EXTRACT_ANON_NSPACES   = NO
+
+# If the HIDE_UNDOC_MEMBERS tag is set to YES, Doxygen will hide all
+# undocumented members of documented classes, files or namespaces.
+# If set to NO (the default) these members will be included in the
+# various overviews, but no documentation section is generated.
+# This option has no effect if EXTRACT_ALL is enabled.
+
+HIDE_UNDOC_MEMBERS     = NO
+
+# If the HIDE_UNDOC_CLASSES tag is set to YES, Doxygen will hide all
+# undocumented classes that are normally visible in the class hierarchy.
+# If set to NO (the default) these classes will be included in the various
+# overviews. This option has no effect if EXTRACT_ALL is enabled.
+
+HIDE_UNDOC_CLASSES     = NO
+
+# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, Doxygen will hide all
+# friend (class|struct|union) declarations.
+# If set to NO (the default) these declarations will be included in the
+# documentation.
+
+HIDE_FRIEND_COMPOUNDS  = NO
+
+# If the HIDE_IN_BODY_DOCS tag is set to YES, Doxygen will hide any
+# documentation blocks found inside the body of a function.
+# If set to NO (the default) these blocks will be appended to the
+# function's detailed documentation block.
+
+HIDE_IN_BODY_DOCS      = NO
+
+# The INTERNAL_DOCS tag determines if documentation
+# that is typed after a \internal command is included. If the tag is set
+# to NO (the default) then the documentation will be excluded.
+# Set it to YES to include the internal documentation.
+
+INTERNAL_DOCS          = NO
+
+# If the CASE_SENSE_NAMES tag is set to NO then Doxygen will only generate
+# file names in lower-case letters. If set to YES upper-case letters are also
+# allowed. This is useful if you have classes or files whose names only differ
+# in case and if your file system supports case sensitive file names. Windows
+# and Mac users are advised to set this option to NO.
+
+CASE_SENSE_NAMES       = NO
+
+# If the HIDE_SCOPE_NAMES tag is set to NO (the default) then Doxygen
+# will show members with their full class and namespace scopes in the
+# documentation. If set to YES the scope will be hidden.
+
+HIDE_SCOPE_NAMES       = NO
+
+# If the SHOW_INCLUDE_FILES tag is set to YES (the default) then Doxygen
+# will put a list of the files that are included by a file in the documentation
+# of that file.
+
+SHOW_INCLUDE_FILES     = YES
+
+# If the FORCE_LOCAL_INCLUDES tag is set to YES then Doxygen
+# will list include files with double quotes in the documentation
+# rather than with sharp brackets.
+
+FORCE_LOCAL_INCLUDES   = NO
+
+# If the INLINE_INFO tag is set to YES (the default) then a tag [inline]
+# is inserted in the documentation for inline members.
+
+INLINE_INFO            = YES
+
+# If the SORT_MEMBER_DOCS tag is set to YES (the default) then doxygen
+# will sort the (detailed) documentation of file and class members
+# alphabetically by member name. If set to NO the members will appear in
+# declaration order.
+
+SORT_MEMBER_DOCS       = YES
+
+# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the
+# brief documentation of file, namespace and class members alphabetically
+# by member name. If set to NO (the default) the members will appear in
+# declaration order.
+
+SORT_BRIEF_DOCS        = NO
+
+# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the (brief and detailed) documentation of class members so that constructors and destructors are listed first. If set to NO (the default) the constructors will appear in the respective orders defined by SORT_MEMBER_DOCS and SORT_BRIEF_DOCS. This tag will be ignored for brief docs if SORT_BRIEF_DOCS is set to NO and ignored for detailed docs if SORT_MEMBER_DOCS is set to NO.
+
+SORT_MEMBERS_CTORS_1ST = NO
+
+# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the
+# hierarchy of group names into alphabetical order. If set to NO (the default)
+# the group names will appear in their defined order.
+
+SORT_GROUP_NAMES       = NO
+
+# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be
+# sorted by fully-qualified names, including namespaces. If set to
+# NO (the default), the class list will be sorted only by class name,
+# not including the namespace part.
+# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES.
+# Note: This option applies only to the class list, not to the
+# alphabetical list.
+
+SORT_BY_SCOPE_NAME     = NO
+
+# The GENERATE_TODOLIST tag can be used to enable (YES) or
+# disable (NO) the todo list. This list is created by putting \todo
+# commands in the documentation.
+
+GENERATE_TODOLIST      = YES
+
+# The GENERATE_TESTLIST tag can be used to enable (YES) or
+# disable (NO) the test list. This list is created by putting \test
+# commands in the documentation.
+
+GENERATE_TESTLIST      = YES
+
+# The GENERATE_BUGLIST tag can be used to enable (YES) or
+# disable (NO) the bug list. This list is created by putting \bug
+# commands in the documentation.
+
+GENERATE_BUGLIST       = YES
+
+# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or
+# disable (NO) the deprecated list. This list is created by putting
+# \deprecated commands in the documentation.
+
+GENERATE_DEPRECATEDLIST= YES
+
+# The ENABLED_SECTIONS tag can be used to enable conditional
+# documentation sections, marked by \if sectionname ... \endif.
+
+ENABLED_SECTIONS       =
+
+# The MAX_INITIALIZER_LINES tag determines the maximum number of lines
+# the initial value of a variable or define consists of for it to appear in
+# the documentation. If the initializer consists of more lines than specified
+# here it will be hidden. Use a value of 0 to hide initializers completely.
+# The appearance of the initializer of individual variables and defines in the
+# documentation can be controlled using \showinitializer or \hideinitializer
+# command in the documentation regardless of this setting.
+
+MAX_INITIALIZER_LINES  = 30
+
+# Set the SHOW_USED_FILES tag to NO to disable the list of files generated
+# at the bottom of the documentation of classes and structs. If set to YES the
+# list will mention the files that were used to generate the documentation.
+
+SHOW_USED_FILES        = YES
+
+# If the sources in your project are distributed over multiple directories
+# then setting the SHOW_DIRECTORIES tag to YES will show the directory hierarchy
+# in the documentation. The default is NO.
+
+SHOW_DIRECTORIES       = YES
+
+# Set the SHOW_FILES tag to NO to disable the generation of the Files page.
+# This will remove the Files entry from the Quick Index and from the
+# Folder Tree View (if specified). The default is YES.
+
+SHOW_FILES             = YES
+
+# Set the SHOW_NAMESPACES tag to NO to disable the generation of the
+# Namespaces page.
+# This will remove the Namespaces entry from the Quick Index
+# and from the Folder Tree View (if specified). The default is YES.
+
+SHOW_NAMESPACES        = YES
+
+# The FILE_VERSION_FILTER tag can be used to specify a program or script that
+# doxygen should invoke to get the current version for each file (typically from
+# the version control system). Doxygen will invoke the program by executing (via
+# popen()) the command <command> <input-file>, where <command> is the value of
+# the FILE_VERSION_FILTER tag, and <input-file> is the name of an input file
+# provided by doxygen. Whatever the program writes to standard output
+# is used as the file version. See the manual for examples.
+
+FILE_VERSION_FILTER    =
+
+# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed by
+# doxygen. The layout file controls the global structure of the generated output files
+# in an output format independent way. The create the layout file that represents
+# doxygen's defaults, run doxygen with the -l option. You can optionally specify a
+# file name after the option, if omitted DoxygenLayout.xml will be used as the name
+# of the layout file.
+
+LAYOUT_FILE            =
+
+#---------------------------------------------------------------------------
+# configuration options related to warning and progress messages
+#---------------------------------------------------------------------------
+
+# The QUIET tag can be used to turn on/off the messages that are generated
+# by doxygen. Possible values are YES and NO. If left blank NO is used.
+
+QUIET                  = NO
+
+# The WARNINGS tag can be used to turn on/off the warning messages that are
+# generated by doxygen. Possible values are YES and NO. If left blank
+# NO is used.
+
+WARNINGS               = YES
+
+# If WARN_IF_UNDOCUMENTED is set to YES, then doxygen will generate warnings
+# for undocumented members. If EXTRACT_ALL is set to YES then this flag will
+# automatically be disabled.
+
+WARN_IF_UNDOCUMENTED   = YES
+
+# If WARN_IF_DOC_ERROR is set to YES, doxygen will generate warnings for
+# potential errors in the documentation, such as not documenting some
+# parameters in a documented function, or documenting parameters that
+# don't exist or using markup commands wrongly.
+
+WARN_IF_DOC_ERROR      = YES
+
+# This WARN_NO_PARAMDOC option can be abled to get warnings for
+# functions that are documented, but have no documentation for their parameters
+# or return value. If set to NO (the default) doxygen will only warn about
+# wrong or incomplete parameter documentation, but not about the absence of
+# documentation.
+
+WARN_NO_PARAMDOC       = NO
+
+# The WARN_FORMAT tag determines the format of the warning messages that
+# doxygen can produce. The string should contain the $file, $line, and $text
+# tags, which will be replaced by the file and line number from which the
+# warning originated and the warning text. Optionally the format may contain
+# $version, which will be replaced by the version of the file (if it could
+# be obtained via FILE_VERSION_FILTER)
+
+WARN_FORMAT            = "$file:$line: $text"
+
+# The WARN_LOGFILE tag can be used to specify a file to which warning
+# and error messages should be written. If left blank the output is written
+# to stderr.
+
+WARN_LOGFILE           =
+
+#---------------------------------------------------------------------------
+# configuration options related to the input files
+#---------------------------------------------------------------------------
+
+# The INPUT tag can be used to specify the files and/or directories that contain
+# documented source files. You may enter file names like "myfile.cpp" or
+# directories like "/usr/src/myproject". Separate the files or directories
+# with spaces.
+
+INPUT                  = /Volumes/p86mart@Cesium/CPL/MOZAIC/src
+
+# This tag can be used to specify the character encoding of the source files
+# that doxygen parses. Internally doxygen uses the UTF-8 encoding, which is
+# also the default input encoding. Doxygen uses libiconv (or the iconv built
+# into libc) for the transcoding. See http://www.gnu.org/software/libiconv for
+# the list of possible encodings.
+
+INPUT_ENCODING         = UTF-8
+
+# If the value of the INPUT tag contains directories, you can use the
+# FILE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp
+# and *.h) to filter out the source-files in the directories. If left
+# blank the following patterns are tested:
+# *.c *.cc *.cxx *.cpp *.c++ *.java *.ii *.ixx *.ipp *.i++ *.inl *.h *.hh *.hxx
+# *.hpp *.h++ *.idl *.odl *.cs *.php *.php3 *.inc *.m *.mm *.py *.f90
+
+FILE_PATTERNS          = *.f *.f90 *.F *.F90
+
+# The RECURSIVE tag can be used to turn specify whether or not subdirectories
+# should be searched for input files as well. Possible values are YES and NO.
+# If left blank NO is used.
+
+RECURSIVE              = YES
+
+# The EXCLUDE tag can be used to specify files and/or directories that should
+# excluded from the INPUT source files. This way you can easily exclude a
+# subdirectory from a directory tree whose root is specified with the INPUT tag.
+
+EXCLUDE                = IOIPSL
+
+# The EXCLUDE_SYMLINKS tag can be used select whether or not files or
+# directories that are symbolic links (a Unix filesystem feature) are excluded
+# from the input.
+
+EXCLUDE_SYMLINKS       = NO
+
+# If the value of the INPUT tag contains directories, you can use the
+# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude
+# certain files from those directories. Note that the wildcards are matched
+# against the file with absolute path, so to exclude all test directories
+# for example use the pattern */test/*
+
+EXCLUDE_PATTERNS       =
+
+# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names
+# (namespaces, classes, functions, etc.) that should be excluded from the
+# output. The symbol name can be a fully qualified name, a word, or if the
+# wildcard * is used, a substring. Examples: ANamespace, AClass,
+# AClass::ANamespace, ANamespace::*Test
+
+EXCLUDE_SYMBOLS        =
+
+# The EXAMPLE_PATH tag can be used to specify one or more files or
+# directories that contain example code fragments that are included (see
+# the \include command).
+
+EXAMPLE_PATH           =
+
+# If the value of the EXAMPLE_PATH tag contains directories, you can use the
+# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp
+# and *.h) to filter out the source-files in the directories. If left
+# blank all files are included.
+
+EXAMPLE_PATTERNS       =
+
+# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be
+# searched for input files to be used with the \include or \dontinclude
+# commands irrespective of the value of the RECURSIVE tag.
+# Possible values are YES and NO. If left blank NO is used.
+
+EXAMPLE_RECURSIVE      = NO
+
+# The IMAGE_PATH tag can be used to specify one or more files or
+# directories that contain image that are included in the documentation (see
+# the \image command).
+
+IMAGE_PATH             =
+
+# The INPUT_FILTER tag can be used to specify a program that doxygen should
+# invoke to filter for each input file. Doxygen will invoke the filter program
+# by executing (via popen()) the command <filter> <input-file>, where <filter>
+# is the value of the INPUT_FILTER tag, and <input-file> is the name of an
+# input file. Doxygen will then use the output that the filter program writes
+# to standard output.
+# If FILTER_PATTERNS is specified, this tag will be
+# ignored.
+
+INPUT_FILTER           =
+
+# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern
+# basis.
+# Doxygen will compare the file name with each pattern and apply the
+# filter if there is a match.
+# The filters are a list of the form:
+# pattern=filter (like *.cpp=my_cpp_filter). See INPUT_FILTER for further
+# info on how filters are used. If FILTER_PATTERNS is empty, INPUT_FILTER
+# is applied to all files.
+
+FILTER_PATTERNS        =
+
+# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using
+# INPUT_FILTER) will be used to filter the input files when producing source
+# files to browse (i.e. when SOURCE_BROWSER is set to YES).
+
+FILTER_SOURCE_FILES    = NO
+
+#---------------------------------------------------------------------------
+# configuration options related to source browsing
+#---------------------------------------------------------------------------
+
+# If the SOURCE_BROWSER tag is set to YES then a list of source files will
+# be generated. Documented entities will be cross-referenced with these sources.
+# Note: To get rid of all source code in the generated output, make sure also
+# VERBATIM_HEADERS is set to NO.
+
+SOURCE_BROWSER         = YES
+
+# Setting the INLINE_SOURCES tag to YES will include the body
+# of functions and classes directly in the documentation.
+
+INLINE_SOURCES         = YES
+
+# Setting the STRIP_CODE_COMMENTS tag to YES (the default) will instruct
+# doxygen to hide any special comment blocks from generated source code
+# fragments. Normal C and C++ comments will always remain visible.
+
+STRIP_CODE_COMMENTS    = NO
+
+# If the REFERENCED_BY_RELATION tag is set to YES
+# then for each documented function all documented
+# functions referencing it will be listed.
+
+REFERENCED_BY_RELATION = YES
+
+# If the REFERENCES_RELATION tag is set to YES
+# then for each documented function all documented entities
+# called/used by that function will be listed.
+
+REFERENCES_RELATION    = YES
+
+# If the REFERENCES_LINK_SOURCE tag is set to YES (the default)
+# and SOURCE_BROWSER tag is set to YES, then the hyperlinks from
+# functions in REFERENCES_RELATION and REFERENCED_BY_RELATION lists will
+# link to the source code.
+# Otherwise they will link to the documentation.
+
+REFERENCES_LINK_SOURCE = YES
+
+# If the USE_HTAGS tag is set to YES then the references to source code
+# will point to the HTML generated by the htags(1) tool instead of doxygen
+# built-in source browser. The htags tool is part of GNU's global source
+# tagging system (see http://www.gnu.org/software/global/global.html). You
+# will need version 4.8.6 or higher.
+
+USE_HTAGS              = NO
+
+# If the VERBATIM_HEADERS tag is set to YES (the default) then Doxygen
+# will generate a verbatim copy of the header file for each class for
+# which an include is specified. Set to NO to disable this.
+
+VERBATIM_HEADERS       = YES
+
+#---------------------------------------------------------------------------
+# configuration options related to the alphabetical class index
+#---------------------------------------------------------------------------
+
+# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index
+# of all compounds will be generated. Enable this if the project
+# contains a lot of classes, structs, unions or interfaces.
+
+ALPHABETICAL_INDEX     = NO
+
+# If the alphabetical index is enabled (see ALPHABETICAL_INDEX) then
+# the COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns
+# in which this list will be split (can be a number in the range [1..20])
+
+COLS_IN_ALPHA_INDEX    = 5
+
+# In case all classes in a project start with a common prefix, all
+# classes will be put under the same header in the alphabetical index.
+# The IGNORE_PREFIX tag can be used to specify one or more prefixes that
+# should be ignored while generating the index headers.
+
+IGNORE_PREFIX          =
+
+#---------------------------------------------------------------------------
+# configuration options related to the HTML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_HTML tag is set to YES (the default) Doxygen will
+# generate HTML output.
+
+GENERATE_HTML          = YES
+
+# The HTML_OUTPUT tag is used to specify where the HTML docs will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be
+# put in front of it. If left blank `html' will be used as the default path.
+
+HTML_OUTPUT            = html
+
+# The HTML_FILE_EXTENSION tag can be used to specify the file extension for
+# each generated HTML page (for example: .htm,.php,.asp). If it is left blank
+# doxygen will generate files with .html extension.
+
+HTML_FILE_EXTENSION    = .html
+
+# The HTML_HEADER tag can be used to specify a personal HTML header for
+# each generated HTML page. If it is left blank doxygen will generate a
+# standard header.
+
+HTML_HEADER            =
+
+# The HTML_FOOTER tag can be used to specify a personal HTML footer for
+# each generated HTML page. If it is left blank doxygen will generate a
+# standard footer.
+
+HTML_FOOTER            =
+
+# The HTML_STYLESHEET tag can be used to specify a user-defined cascading
+# style sheet that is used by each HTML page. It can be used to
+# fine-tune the look of the HTML output. If the tag is left blank doxygen
+# will generate a default style sheet. Note that doxygen will try to copy
+# the style sheet file to the HTML output directory, so don't put your own
+# stylesheet in the HTML output directory as well, or it will be erased!
+
+HTML_STYLESHEET        =
+
+# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML
+# page will contain the date and time when the page was generated. Setting
+# this to NO can help when comparing the output of multiple runs.
+
+HTML_TIMESTAMP         = YES
+
+# If the HTML_ALIGN_MEMBERS tag is set to YES, the members of classes,
+# files or namespaces will be aligned in HTML using tables. If set to
+# NO a bullet list will be used.
+
+HTML_ALIGN_MEMBERS     = YES
+
+# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML
+# documentation will contain sections that can be hidden and shown after the
+# page has loaded. For this to work a browser that supports
+# JavaScript and DHTML is required (for instance Mozilla 1.0+, Firefox
+# Netscape 6.0+, Internet explorer 5.0+, Konqueror, or Safari).
+
+HTML_DYNAMIC_SECTIONS  = NO
+
+# If the GENERATE_DOCSET tag is set to YES, additional index files
+# will be generated that can be used as input for Apple's Xcode 3
+# integrated development environment, introduced with OSX 10.5 (Leopard).
+# To create a documentation set, doxygen will generate a Makefile in the
+# HTML output directory. Running make will produce the docset in that
+# directory and running "make install" will install the docset in
+# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find
+# it at startup.
+# See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html for more information.
+
+GENERATE_DOCSET        = NO
+
+# When GENERATE_DOCSET tag is set to YES, this tag determines the name of the
+# feed. A documentation feed provides an umbrella under which multiple
+# documentation sets from a single provider (such as a company or product suite)
+# can be grouped.
+
+DOCSET_FEEDNAME        = "Doxygen generated docs"
+
+# When GENERATE_DOCSET tag is set to YES, this tag specifies a string that
+# should uniquely identify the documentation set bundle. This should be a
+# reverse domain-name style string, e.g. com.mycompany.MyDocSet. Doxygen
+# will append .docset to the name.
+
+DOCSET_BUNDLE_ID       = org.doxygen.Project
+
+# If the GENERATE_HTMLHELP tag is set to YES, additional index files
+# will be generated that can be used as input for tools like the
+# Microsoft HTML help workshop to generate a compiled HTML help file (.chm)
+# of the generated HTML documentation.
+
+GENERATE_HTMLHELP      = NO
+
+# If the GENERATE_HTMLHELP tag is set to YES, the CHM_FILE tag can
+# be used to specify the file name of the resulting .chm file. You
+# can add a path in front of the file if the result should not be
+# written to the html output directory.
+
+CHM_FILE               =
+
+# If the GENERATE_HTMLHELP tag is set to YES, the HHC_LOCATION tag can
+# be used to specify the location (absolute path including file name) of
+# the HTML help compiler (hhc.exe). If non-empty doxygen will try to run
+# the HTML help compiler on the generated index.hhp.
+
+HHC_LOCATION           =
+
+# If the GENERATE_HTMLHELP tag is set to YES, the GENERATE_CHI flag
+# controls if a separate .chi index file is generated (YES) or that
+# it should be included in the master .chm file (NO).
+
+GENERATE_CHI           = NO
+
+# If the GENERATE_HTMLHELP tag is set to YES, the CHM_INDEX_ENCODING
+# is used to encode HtmlHelp index (hhk), content (hhc) and project file
+# content.
+
+CHM_INDEX_ENCODING     =
+
+# If the GENERATE_HTMLHELP tag is set to YES, the BINARY_TOC flag
+# controls whether a binary table of contents is generated (YES) or a
+# normal table of contents (NO) in the .chm file.
+
+BINARY_TOC             = NO
+
+# The TOC_EXPAND flag can be set to YES to add extra items for group members
+# to the contents of the HTML help documentation and to the tree view.
+
+TOC_EXPAND             = NO
+
+# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and QHP_VIRTUAL_FOLDER
+# are set, an additional index file will be generated that can be used as input for
+# Qt's qhelpgenerator to generate a Qt Compressed Help (.qch) of the generated
+# HTML documentation.
+
+GENERATE_QHP           = NO
+
+# If the QHG_LOCATION tag is specified, the QCH_FILE tag can
+# be used to specify the file name of the resulting .qch file.
+# The path specified is relative to the HTML output folder.
+
+QCH_FILE               =
+
+# The QHP_NAMESPACE tag specifies the namespace to use when generating
+# Qt Help Project output. For more information please see
+# http://doc.trolltech.com/qthelpproject.html#namespace
+
+QHP_NAMESPACE          = org.doxygen.Project
+
+# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating
+# Qt Help Project output. For more information please see
+# http://doc.trolltech.com/qthelpproject.html#virtual-folders
+
+QHP_VIRTUAL_FOLDER     = doc
+
+# If QHP_CUST_FILTER_NAME is set, it specifies the name of a custom filter to add.
+# For more information please see
+# http://doc.trolltech.com/qthelpproject.html#custom-filters
+
+QHP_CUST_FILTER_NAME   =
+
+# The QHP_CUST_FILT_ATTRS tag specifies the list of the attributes of the custom filter to add.For more information please see
+# <a href="http://doc.trolltech.com/qthelpproject.html#custom-filters">Qt Help Project / Custom Filters</a>.
+
+QHP_CUST_FILTER_ATTRS  =
+
+# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this project's
+# filter section matches.
+# <a href="http://doc.trolltech.com/qthelpproject.html#filter-attributes">Qt Help Project / Filter Attributes</a>.
+
+QHP_SECT_FILTER_ATTRS  =
+
+# If the GENERATE_QHP tag is set to YES, the QHG_LOCATION tag can
+# be used to specify the location of Qt's qhelpgenerator.
+# If non-empty doxygen will try to run qhelpgenerator on the generated
+# .qhp file.
+
+QHG_LOCATION           =
+
+# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files
+#  will be generated, which together with the HTML files, form an Eclipse help
+#  plugin. To install this plugin and make it available under the help contents
+# menu in Eclipse, the contents of the directory containing the HTML and XML
+# files needs to be copied into the plugins directory of eclipse. The name of
+# the directory within the plugins directory should be the same as
+# the ECLIPSE_DOC_ID value. After copying Eclipse needs to be restarted before the help appears.
+
+GENERATE_ECLIPSEHELP   = NO
+
+# A unique identifier for the eclipse help plugin. When installing the plugin
+# the directory name containing the HTML and XML files should also have
+# this name.
+
+ECLIPSE_DOC_ID         = org.doxygen.Project
+
+# The DISABLE_INDEX tag can be used to turn on/off the condensed index at
+# top of each HTML page. The value NO (the default) enables the index and
+# the value YES disables it.
+
+DISABLE_INDEX          = NO
+
+# This tag can be used to set the number of enum values (range [1..20])
+# that doxygen will group on one line in the generated HTML documentation.
+
+ENUM_VALUES_PER_LINE   = 4
+
+# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index
+# structure should be generated to display hierarchical information.
+# If the tag value is set to YES, a side panel will be generated
+# containing a tree-like index structure (just like the one that
+# is generated for HTML Help). For this to work a browser that supports
+# JavaScript, DHTML, CSS and frames is required (i.e. any modern browser).
+# Windows users are probably better off using the HTML help feature.
+
+GENERATE_TREEVIEW      = YES
+
+# By enabling USE_INLINE_TREES, doxygen will generate the Groups, Directories,
+# and Class Hierarchy pages using a tree view instead of an ordered list.
+
+USE_INLINE_TREES       = YES
+
+# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be
+# used to set the initial width (in pixels) of the frame in which the tree
+# is shown.
+
+TREEVIEW_WIDTH         = 250
+
+# Use this tag to change the font size of Latex formulas included
+# as images in the HTML documentation. The default is 10. Note that
+# when you change the font size after a successful doxygen run you need
+# to manually remove any form_*.png images from the HTML output directory
+# to force them to be regenerated.
+
+FORMULA_FONTSIZE       = 10
+
+# When the SEARCHENGINE tag is enabled doxygen will generate a search box for the HTML output. The underlying search engine uses javascript
+# and DHTML and should work on any modern browser. Note that when using HTML help (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) there is already a search function so this one should
+# typically be disabled. For large projects the javascript based search engine
+# can be slow, then enabling SERVER_BASED_SEARCH may provide a better solution.
+
+SEARCHENGINE           = YES
+
+# When the SERVER_BASED_SEARCH tag is enabled the search engine will be implemented using a PHP enabled web server instead of at the web client using Javascript. Doxygen will generate the search PHP script and index
+# file to put on the web server. The advantage of the server based approach is that it scales better to large projects and allows full text search. The disadvances is that it is more difficult to setup
+# and does not have live searching capabilities.
+
+SERVER_BASED_SEARCH    = NO
+
+#---------------------------------------------------------------------------
+# configuration options related to the LaTeX output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_LATEX tag is set to YES (the default) Doxygen will
+# generate Latex output.
+
+GENERATE_LATEX         = NO
+
+# The LATEX_OUTPUT tag is used to specify where the LaTeX docs will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be
+# put in front of it. If left blank `latex' will be used as the default path.
+
+LATEX_OUTPUT           = latex
+
+# The LATEX_CMD_NAME tag can be used to specify the LaTeX command name to be
+# invoked. If left blank `latex' will be used as the default command name.
+# Note that when enabling USE_PDFLATEX this option is only used for
+# generating bitmaps for formulas in the HTML output, but not in the
+# Makefile that is written to the output directory.
+
+LATEX_CMD_NAME         = latex
+
+# The MAKEINDEX_CMD_NAME tag can be used to specify the command name to
+# generate index for LaTeX. If left blank `makeindex' will be used as the
+# default command name.
+
+MAKEINDEX_CMD_NAME     = makeindex
+
+# If the COMPACT_LATEX tag is set to YES Doxygen generates more compact
+# LaTeX documents. This may be useful for small projects and may help to
+# save some trees in general.
+
+COMPACT_LATEX          = NO
+
+# The PAPER_TYPE tag can be used to set the paper type that is used
+# by the printer. Possible values are: a4, a4wide, letter, legal and
+# executive. If left blank a4wide will be used.
+
+PAPER_TYPE             = a4wide
+
+# The EXTRA_PACKAGES tag can be to specify one or more names of LaTeX
+# packages that should be included in the LaTeX output.
+
+EXTRA_PACKAGES         =
+
+# The LATEX_HEADER tag can be used to specify a personal LaTeX header for
+# the generated latex document. The header should contain everything until
+# the first chapter. If it is left blank doxygen will generate a
+# standard header. Notice: only use this tag if you know what you are doing!
+
+LATEX_HEADER           =
+
+# If the PDF_HYPERLINKS tag is set to YES, the LaTeX that is generated
+# is prepared for conversion to pdf (using ps2pdf). The pdf file will
+# contain links (just like the HTML output) instead of page references
+# This makes the output suitable for online browsing using a pdf viewer.
+
+PDF_HYPERLINKS         = YES
+
+# If the USE_PDFLATEX tag is set to YES, pdflatex will be used instead of
+# plain latex in the generated Makefile. Set this option to YES to get a
+# higher quality PDF documentation.
+
+USE_PDFLATEX           = YES
+
+# If the LATEX_BATCHMODE tag is set to YES, doxygen will add the \\batchmode.
+# command to the generated LaTeX files. This will instruct LaTeX to keep
+# running if errors occur, instead of asking the user for help.
+# This option is also used when generating formulas in HTML.
+
+LATEX_BATCHMODE        = NO
+
+# If LATEX_HIDE_INDICES is set to YES then doxygen will not
+# include the index chapters (such as File Index, Compound Index, etc.)
+# in the output.
+
+LATEX_HIDE_INDICES     = NO
+
+# If LATEX_SOURCE_CODE is set to YES then doxygen will include source code with syntax highlighting in the LaTeX output. Note that which sources are shown also depends on other settings such as SOURCE_BROWSER.
+
+LATEX_SOURCE_CODE      = NO
+
+#---------------------------------------------------------------------------
+# configuration options related to the RTF output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_RTF tag is set to YES Doxygen will generate RTF output
+# The RTF output is optimized for Word 97 and may not look very pretty with
+# other RTF readers or editors.
+
+GENERATE_RTF           = NO
+
+# The RTF_OUTPUT tag is used to specify where the RTF docs will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be
+# put in front of it. If left blank `rtf' will be used as the default path.
+
+RTF_OUTPUT             = rtf
+
+# If the COMPACT_RTF tag is set to YES Doxygen generates more compact
+# RTF documents. This may be useful for small projects and may help to
+# save some trees in general.
+
+COMPACT_RTF            = NO
+
+# If the RTF_HYPERLINKS tag is set to YES, the RTF that is generated
+# will contain hyperlink fields. The RTF file will
+# contain links (just like the HTML output) instead of page references.
+# This makes the output suitable for online browsing using WORD or other
+# programs which support those fields.
+# Note: wordpad (write) and others do not support links.
+
+RTF_HYPERLINKS         = NO
+
+# Load stylesheet definitions from file. Syntax is similar to doxygen's
+# config file, i.e. a series of assignments. You only have to provide
+# replacements, missing definitions are set to their default value.
+
+RTF_STYLESHEET_FILE    =
+
+# Set optional variables used in the generation of an rtf document.
+# Syntax is similar to doxygen's config file.
+
+RTF_EXTENSIONS_FILE    =
+
+#---------------------------------------------------------------------------
+# configuration options related to the man page output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_MAN tag is set to YES (the default) Doxygen will
+# generate man pages
+
+GENERATE_MAN           = NO
+
+# The MAN_OUTPUT tag is used to specify where the man pages will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be
+# put in front of it. If left blank `man' will be used as the default path.
+
+MAN_OUTPUT             = man
+
+# The MAN_EXTENSION tag determines the extension that is added to
+# the generated man pages (default is the subroutine's section .3)
+
+MAN_EXTENSION          = .3
+
+# If the MAN_LINKS tag is set to YES and Doxygen generates man output,
+# then it will generate one additional man file for each entity
+# documented in the real man page(s). These additional files
+# only source the real man page, but without them the man command
+# would be unable to find the correct page. The default is NO.
+
+MAN_LINKS              = NO
+
+#---------------------------------------------------------------------------
+# configuration options related to the XML output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_XML tag is set to YES Doxygen will
+# generate an XML file that captures the structure of
+# the code including all documentation.
+
+GENERATE_XML           = NO
+
+# The XML_OUTPUT tag is used to specify where the XML pages will be put.
+# If a relative path is entered the value of OUTPUT_DIRECTORY will be
+# put in front of it. If left blank `xml' will be used as the default path.
+
+XML_OUTPUT             = xml
+
+# The XML_SCHEMA tag can be used to specify an XML schema,
+# which can be used by a validating XML parser to check the
+# syntax of the XML files.
+
+XML_SCHEMA             =
+
+# The XML_DTD tag can be used to specify an XML DTD,
+# which can be used by a validating XML parser to check the
+# syntax of the XML files.
+
+XML_DTD                =
+
+# If the XML_PROGRAMLISTING tag is set to YES Doxygen will
+# dump the program listings (including syntax highlighting
+# and cross-referencing information) to the XML output. Note that
+# enabling this will significantly increase the size of the XML output.
+
+XML_PROGRAMLISTING     = YES
+
+#---------------------------------------------------------------------------
+# configuration options for the AutoGen Definitions output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_AUTOGEN_DEF tag is set to YES Doxygen will
+# generate an AutoGen Definitions (see autogen.sf.net) file
+# that captures the structure of the code including all
+# documentation. Note that this feature is still experimental
+# and incomplete at the moment.
+
+GENERATE_AUTOGEN_DEF   = NO
+
+#---------------------------------------------------------------------------
+# configuration options related to the Perl module output
+#---------------------------------------------------------------------------
+
+# If the GENERATE_PERLMOD tag is set to YES Doxygen will
+# generate a Perl module file that captures the structure of
+# the code including all documentation. Note that this
+# feature is still experimental and incomplete at the
+# moment.
+
+GENERATE_PERLMOD       = NO
+
+# If the PERLMOD_LATEX tag is set to YES Doxygen will generate
+# the necessary Makefile rules, Perl scripts and LaTeX code to be able
+# to generate PDF and DVI output from the Perl module output.
+
+PERLMOD_LATEX          = NO
+
+# If the PERLMOD_PRETTY tag is set to YES the Perl module output will be
+# nicely formatted so it can be parsed by a human reader.
+# This is useful
+# if you want to understand what is going on.
+# On the other hand, if this
+# tag is set to NO the size of the Perl module output will be much smaller
+# and Perl will parse it just the same.
+
+PERLMOD_PRETTY         = YES
+
+# The names of the make variables in the generated doxyrules.make file
+# are prefixed with the string contained in PERLMOD_MAKEVAR_PREFIX.
+# This is useful so different doxyrules.make files included by the same
+# Makefile don't overwrite each other's variables.
+
+PERLMOD_MAKEVAR_PREFIX =
+
+#---------------------------------------------------------------------------
+# Configuration options related to the preprocessor
+#---------------------------------------------------------------------------
+
+# If the ENABLE_PREPROCESSING tag is set to YES (the default) Doxygen will
+# evaluate all C-preprocessor directives found in the sources and include
+# files.
+
+ENABLE_PREPROCESSING   = YES
+
+# If the MACRO_EXPANSION tag is set to YES Doxygen will expand all macro
+# names in the source code. If set to NO (the default) only conditional
+# compilation will be performed. Macro expansion can be done in a controlled
+# way by setting EXPAND_ONLY_PREDEF to YES.
+
+MACRO_EXPANSION        = NO
+
+# If the EXPAND_ONLY_PREDEF and MACRO_EXPANSION tags are both set to YES
+# then the macro expansion is limited to the macros specified with the
+# PREDEFINED and EXPAND_AS_DEFINED tags.
+
+EXPAND_ONLY_PREDEF     = NO
+
+# If the SEARCH_INCLUDES tag is set to YES (the default) the includes files
+# in the INCLUDE_PATH (see below) will be search if a #include is found.
+
+SEARCH_INCLUDES        = YES
+
+# The INCLUDE_PATH tag can be used to specify one or more directories that
+# contain include files that are not input files but should be processed by
+# the preprocessor.
+
+INCLUDE_PATH           =
+
+# You can use the INCLUDE_FILE_PATTERNS tag to specify one or more wildcard
+# patterns (like *.h and *.hpp) to filter out the header-files in the
+# directories. If left blank, the patterns specified with FILE_PATTERNS will
+# be used.
+
+INCLUDE_FILE_PATTERNS  =
+
+# The PREDEFINED tag can be used to specify one or more macro names that
+# are defined before the preprocessor is started (similar to the -D option of
+# gcc). The argument of the tag is a list of macros of the form: name
+# or name=definition (no spaces). If the definition and the = are
+# omitted =1 is assumed. To prevent a macro definition from being
+# undefined via #undef or recursively expanded use the := operator
+# instead of the = operator.
+
+PREDEFINED             =
+
+# If the MACRO_EXPANSION and EXPAND_ONLY_PREDEF tags are set to YES then
+# this tag can be used to specify a list of macro names that should be expanded.
+# The macro definition that is found in the sources will be used.
+# Use the PREDEFINED tag if you want to use a different macro definition.
+
+EXPAND_AS_DEFINED      =
+
+# If the SKIP_FUNCTION_MACROS tag is set to YES (the default) then
+# doxygen's preprocessor will remove all function-like macros that are alone
+# on a line, have an all uppercase name, and do not end with a semicolon. Such
+# function macros are typically used for boiler-plate code, and will confuse
+# the parser if not removed.
+
+SKIP_FUNCTION_MACROS   = YES
+
+#---------------------------------------------------------------------------
+# Configuration::additions related to external references
+#---------------------------------------------------------------------------
+
+# The TAGFILES option can be used to specify one or more tagfiles.
+# Optionally an initial location of the external documentation
+# can be added for each tagfile. The format of a tag file without
+# this location is as follows:
+#
+# TAGFILES = file1 file2 ...
+# Adding location for the tag files is done as follows:
+#
+# TAGFILES = file1=loc1 "file2 = loc2" ...
+# where "loc1" and "loc2" can be relative or absolute paths or
+# URLs. If a location is present for each tag, the installdox tool
+# does not have to be run to correct the links.
+# Note that each tag file must have a unique name
+# (where the name does NOT include the path)
+# If a tag file is not located in the directory in which doxygen
+# is run, you must also specify the path to the tagfile here.
+
+TAGFILES               =
+
+# When a file name is specified after GENERATE_TAGFILE, doxygen will create
+# a tag file that is based on the input files it reads.
+
+GENERATE_TAGFILE       =
+
+# If the ALLEXTERNALS tag is set to YES all external classes will be listed
+# in the class index. If set to NO only the inherited external classes
+# will be listed.
+
+ALLEXTERNALS           = NO
+
+# If the EXTERNAL_GROUPS tag is set to YES all external groups will be listed
+# in the modules index. If set to NO, only the current project's groups will
+# be listed.
+
+EXTERNAL_GROUPS        = YES
+
+# The PERL_PATH should be the absolute path and name of the perl script
+# interpreter (i.e. the result of `which perl').
+
+PERL_PATH              = /usr/bin/perl
+
+#---------------------------------------------------------------------------
+# Configuration options related to the dot tool
+#---------------------------------------------------------------------------
+
+# If the CLASS_DIAGRAMS tag is set to YES (the default) Doxygen will
+# generate a inheritance diagram (in HTML, RTF and LaTeX) for classes with base
+# or super classes. Setting the tag to NO turns the diagrams off. Note that
+# this option is superseded by the HAVE_DOT option below. This is only a
+# fallback. It is recommended to install and use dot, since it yields more
+# powerful graphs.
+
+CLASS_DIAGRAMS         = YES
+
+# You can define message sequence charts within doxygen comments using the \msc
+# command. Doxygen will then run the mscgen tool (see
+# http://www.mcternan.me.uk/mscgen/) to produce the chart and insert it in the
+# documentation. The MSCGEN_PATH tag allows you to specify the directory where
+# the mscgen tool resides. If left empty the tool is assumed to be found in the
+# default search path.
+
+MSCGEN_PATH            =
+
+# If set to YES, the inheritance and collaboration graphs will hide
+# inheritance and usage relations if the target is undocumented
+# or is not a class.
+
+HIDE_UNDOC_RELATIONS   = YES
+
+# If you set the HAVE_DOT tag to YES then doxygen will assume the dot tool is
+# available from the path. This tool is part of Graphviz, a graph visualization
+# toolkit from AT&T and Lucent Bell Labs. The other options in this section
+# have no effect if this option is set to NO (the default)
+
+HAVE_DOT               = NO
+
+# By default doxygen will write a font called FreeSans.ttf to the output
+# directory and reference it in all dot files that doxygen generates. This
+# font does not include all possible unicode characters however, so when you need
+# these (or just want a differently looking font) you can specify the font name
+# using DOT_FONTNAME. You need need to make sure dot is able to find the font,
+# which can be done by putting it in a standard location or by setting the
+# DOTFONTPATH environment variable or by setting DOT_FONTPATH to the directory
+# containing the font.
+
+DOT_FONTNAME           = FreeSans
+
+# The DOT_FONTSIZE tag can be used to set the size of the font of dot graphs.
+# The default size is 10pt.
+
+DOT_FONTSIZE           = 10
+
+# By default doxygen will tell dot to use the output directory to look for the
+# FreeSans.ttf font (which doxygen will put there itself). If you specify a
+# different font using DOT_FONTNAME you can set the path where dot
+# can find it using this tag.
+
+DOT_FONTPATH           =
+
+# If the CLASS_GRAPH and HAVE_DOT tags are set to YES then doxygen
+# will generate a graph for each documented class showing the direct and
+# indirect inheritance relations. Setting this tag to YES will force the
+# the CLASS_DIAGRAMS tag to NO.
+
+CLASS_GRAPH            = YES
+
+# If the COLLABORATION_GRAPH and HAVE_DOT tags are set to YES then doxygen
+# will generate a graph for each documented class showing the direct and
+# indirect implementation dependencies (inheritance, containment, and
+# class references variables) of the class with other documented classes.
+
+COLLABORATION_GRAPH    = YES
+
+# If the GROUP_GRAPHS and HAVE_DOT tags are set to YES then doxygen
+# will generate a graph for groups, showing the direct groups dependencies
+
+GROUP_GRAPHS           = YES
+
+# If the UML_LOOK tag is set to YES doxygen will generate inheritance and
+# collaboration diagrams in a style similar to the OMG's Unified Modeling
+# Language.
+
+UML_LOOK               = NO
+
+# If set to YES, the inheritance and collaboration graphs will show the
+# relations between templates and their instances.
+
+TEMPLATE_RELATIONS     = NO
+
+# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDE_GRAPH, and HAVE_DOT
+# tags are set to YES then doxygen will generate a graph for each documented
+# file showing the direct and indirect include dependencies of the file with
+# other documented files.
+
+INCLUDE_GRAPH          = YES
+
+# If the ENABLE_PREPROCESSING, SEARCH_INCLUDES, INCLUDED_BY_GRAPH, and
+# HAVE_DOT tags are set to YES then doxygen will generate a graph for each
+# documented header file showing the documented files that directly or
+# indirectly include this file.
+
+INCLUDED_BY_GRAPH      = YES
+
+# If the CALL_GRAPH and HAVE_DOT options are set to YES then
+# doxygen will generate a call dependency graph for every global function
+# or class method. Note that enabling this option will significantly increase
+# the time of a run. So in most cases it will be better to enable call graphs
+# for selected functions only using the \callgraph command.
+
+CALL_GRAPH             = NO
+
+# If the CALLER_GRAPH and HAVE_DOT tags are set to YES then
+# doxygen will generate a caller dependency graph for every global function
+# or class method. Note that enabling this option will significantly increase
+# the time of a run. So in most cases it will be better to enable caller
+# graphs for selected functions only using the \callergraph command.
+
+CALLER_GRAPH           = NO
+
+# If the GRAPHICAL_HIERARCHY and HAVE_DOT tags are set to YES then doxygen
+# will graphical hierarchy of all classes instead of a textual one.
+
+GRAPHICAL_HIERARCHY    = YES
+
+# If the DIRECTORY_GRAPH, SHOW_DIRECTORIES and HAVE_DOT tags are set to YES
+# then doxygen will show the dependencies a directory has on other directories
+# in a graphical way. The dependency relations are determined by the #include
+# relations between the files in the directories.
+
+DIRECTORY_GRAPH        = YES
+
+# The DOT_IMAGE_FORMAT tag can be used to set the image format of the images
+# generated by dot. Possible values are png, jpg, or gif
+# If left blank png will be used.
+
+DOT_IMAGE_FORMAT       = png
+
+# The tag DOT_PATH can be used to specify the path where the dot tool can be
+# found. If left blank, it is assumed the dot tool can be found in the path.
+
+DOT_PATH               =
+
+# The DOTFILE_DIRS tag can be used to specify one or more directories that
+# contain dot files that are included in the documentation (see the
+# \dotfile command).
+
+DOTFILE_DIRS           =
+
+# The DOT_GRAPH_MAX_NODES tag can be used to set the maximum number of
+# nodes that will be shown in the graph. If the number of nodes in a graph
+# becomes larger than this value, doxygen will truncate the graph, which is
+# visualized by representing a node as a red box. Note that doxygen if the
+# number of direct children of the root node in a graph is already larger than
+# DOT_GRAPH_MAX_NODES then the graph will not be shown at all. Also note
+# that the size of a graph can be further restricted by MAX_DOT_GRAPH_DEPTH.
+
+DOT_GRAPH_MAX_NODES    = 50
+
+# The MAX_DOT_GRAPH_DEPTH tag can be used to set the maximum depth of the
+# graphs generated by dot. A depth value of 3 means that only nodes reachable
+# from the root by following a path via at most 3 edges will be shown. Nodes
+# that lay further from the root node will be omitted. Note that setting this
+# option to 1 or 2 may greatly reduce the computation time needed for large
+# code bases. Also note that the size of a graph can be further restricted by
+# DOT_GRAPH_MAX_NODES. Using a depth of 0 means no depth restriction.
+
+MAX_DOT_GRAPH_DEPTH    = 0
+
+# Set the DOT_TRANSPARENT tag to YES to generate images with a transparent
+# background. This is disabled by default, because dot on Windows does not
+# seem to support this out of the box. Warning: Depending on the platform used,
+# enabling this option may lead to badly anti-aliased labels on the edges of
+# a graph (i.e. they become hard to read).
+
+DOT_TRANSPARENT        = NO
+
+# Set the DOT_MULTI_TARGETS tag to YES allow dot to generate multiple output
+# files in one run (i.e. multiple -o and -T options on the command line). This
+# makes dot run faster, but since only newer versions of dot (>1.8.10)
+# support this, this feature is disabled by default.
+
+DOT_MULTI_TARGETS      = NO
+
+# If the GENERATE_LEGEND tag is set to YES (the default) Doxygen will
+# generate a legend page explaining the meaning of the various boxes and
+# arrows in the dot generated graphs.
+
+GENERATE_LEGEND        = YES
+
+# If the DOT_CLEANUP tag is set to YES (the default) Doxygen will
+# remove the intermediate dot files that are used to generate
+# the various graphs.
+
+DOT_CLEANUP            = YES
Index: /TOOLS/MOZAIC/Makefile
===================================================================
--- /TOOLS/MOZAIC/Makefile	(revision 3326)
+++ /TOOLS/MOZAIC/Makefile	(revision 3326)
@@ -0,0 +1,805 @@
+# Automatic Makefile
+
+FCM_BLD_CFG = /ccc/cont003/dsku/zinc/home/user/dsm/p86mart/CPL/MOZAIC/bld.cfg
+export FCM_VERBOSE ?= 1
+
+export FCM_ROOTDIR := /ccc/cont003/home/dsm/p86mart/CPL/MOZAIC
+export FCM_CACHEDIR := $(FCM_ROOTDIR)/.cache/.bld
+export FCM_CFGDIR := $(FCM_ROOTDIR)/cfg
+export FCM_SRCDIR := $(FCM_ROOTDIR)/src
+export FCM_BINDIR := $(FCM_ROOTDIR)/bin
+export FCM_ETCDIR := $(FCM_ROOTDIR)/etc
+export FCM_LIBDIR := $(FCM_ROOTDIR)/lib
+export FCM_TMPDIR := $(FCM_ROOTDIR)/tmp
+export FCM_DONEDIR := $(FCM_ROOTDIR)/done
+export FCM_FLAGSDIR := $(FCM_ROOTDIR)/flags
+export FCM_INCDIR := $(FCM_ROOTDIR)/inc
+export FCM_PPSRCDIR := $(FCM_ROOTDIR)/ppsrc
+export FCM_OBJDIR := $(FCM_ROOTDIR)/obj
+export FCM_ROOTPATH := $(FCM_ROOTDIR)
+export FCM_CACHEPATH := $(FCM_CACHEDIR)
+export FCM_CFGPATH := $(FCM_CFGDIR)
+export FCM_SRCPATH := $(FCM_SRCDIR)
+export FCM_BINPATH := $(FCM_BINDIR)
+export FCM_ETCPATH := $(FCM_ETCDIR)
+export FCM_LIBPATH := $(FCM_LIBDIR)
+export FCM_TMPPATH := $(FCM_TMPDIR)
+export FCM_DONEPATH := $(FCM_DONEDIR)
+export FCM_FLAGSPATH := $(FCM_FLAGSDIR)
+export FCM_INCPATH := $(FCM_INCDIR)
+export FCM_PPSRCPATH := $(FCM_PPSRCDIR)
+export FCM_OBJPATH := $(FCM_OBJDIR)
+
+export PERL5LIB := /ccc/cont003/dsku/zinc/home/user/dsm/p86mart/EXE/fcm-1.5/bin/../lib
+
+export AR = ar
+export ARFLAGS = rs
+export CC = cc
+export CC_COMPILE = -c
+export CC_DEFINE = -D
+export CC_INCLUDE = -I
+export CC_OUTPUT = -o
+export CFLAGS = 
+export CPPKEYS = 
+export DIFF3FLAGS = -E -m
+export FC = ifort  -i4 -r8 -convert big_endian
+export FC_COMPILE = -c
+export FC_DEFINE = -D
+export FC_INCLUDE = -I
+export FC_MODSEARCH = 
+export FC_OUTPUT = -o
+export FFLAGS = -g -traceback -DJPOL=180 -I/ccc/products/netcdf-4.3.3.1_hdf5_parallel/default/include -L/ccc/products/netcdf-4.3.3.1_hdf5_parallel/default/lib
+export FPPKEYS = 
+export LD = ifort  -i4 -r8 -convert big_endian -g -traceback -I/ccc/products/netcdf-4.3.3.1_hdf5_parallel/default/include -L/ccc/products/netcdf-4.3.3.1_hdf5_parallel/default/lib
+export LDFLAGS = -lnetcdff -lnetcdf
+export LD_LIBLINK = -l
+export LD_LIBSEARCH = -L
+export LD_OUTPUT = -o
+export SHELL = /bin/ksh
+
+vpath % $(FCM_BINPATH)
+vpath %.done $(FCM_DONEPATH)
+vpath %.idone $(FCM_DONEPATH)
+vpath %.etc $(FCM_ETCPATH)
+vpath %.flags $(FCM_FLAGSPATH)
+vpath % $(FCM_INCPATH)
+vpath %.a $(FCM_LIBPATH)
+vpath %.o $(FCM_OBJPATH)
+
+FCM_BLD_TARGETS = lmdz.exe allgrid.exe mosaic.exe cotes_etal.exe isf_icb.exe icestream.exe calving.exe inv_wei.exe tstmosaic.exe
+
+.PHONY : all
+
+all : $(FCM_BLD_TARGETS)
+
+$(FCM_DONEDIR)/FCM_CP.dummy:
+	touch $@
+
+CFLAGS__POLY.flags: CFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+CPPKEYS__POLY.flags: CPPKEYS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FFLAGS__POLY.flags: FFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FPPKEYS__POLY.flags: FPPKEYS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__POLY.flags: LDFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__POLY.flags: LD.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+OBJECTS__POLY = m_g2d.o mt_c2d.o mt_polyg.o poly_types.o u_graph.o u_polyg.o
+
+libPOLY.a: $(OBJECTS__POLY)
+	fcm_internal archive $@ $^
+
+CFLAGS__MOZAIC.flags: CFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+CPPKEYS__MOZAIC.flags: CPPKEYS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FFLAGS__MOZAIC.flags: FFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FPPKEYS__MOZAIC.flags: FPPKEYS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC.flags: LDFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC.flags: LD.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+MOZAIC.etc: $(FCM_SRCDIR)/MOZAIC/lbc2.f90_unused $(FCM_DONEDIR)/FCM_CP.dummy
+	cp $^ $(FCM_ETCDIR)
+	touch $(FCM_ETCDIR)/$@
+
+OBJECTS__MOZAIC = bords.o mod_build.o chrono.o correct_a2o.o mod_correct.o mod_cotes_a.o data_types.o declare.o dimensions.o formula.o mod_inipar.o mod_inter.o declare_1.o mod_lbc.o mod_lbc_1.o mod_lbc_2.o mod_lecdata.o d1.o mod_locio.o math.o modeles.o mod_neuf.o mod_norma.o norma.o mod_polom.o mod_polyw_a.o mod_polyw_a_fast.o mod_polyw_o.o mod_prih.o mod_proj.o mod_rectifie.o declare_2.o mod_util.o mod_wri_wei.o mod_wripoly.o
+
+libMOZAIC.a: $(OBJECTS__MOZAIC)
+	fcm_internal archive $@ $^
+
+CFLAGS__IOIPSL.flags: CFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+CPPKEYS__IOIPSL.flags: CPPKEYS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FFLAGS__IOIPSL.flags: FFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FPPKEYS__IOIPSL.flags: FPPKEYS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+IOIPSL.etc: $(FCM_SRCDIR)/IOIPSL/AA_make $(FCM_SRCDIR)/IOIPSL/def.prec $(FCM_SRCDIR)/IOIPSL/AA_make.ldef $(FCM_DONEDIR)/FCM_CP.dummy
+	cp $^ $(FCM_ETCDIR)
+	touch $(FCM_ETCDIR)/$@
+
+LDFLAGS__IOIPSL.flags: LDFLAGS.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__IOIPSL.flags: LD.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+OBJECTS__IOIPSL = calendar.o defprec.o errioipsl.o fliocom.o getincom.o stringop.o
+
+libIOIPSL.a: $(OBJECTS__IOIPSL)
+	fcm_internal archive $@ $^
+
+CC.flags:
+	touch $(FCM_FLAGSDIR)/$@
+
+CFLAGS.flags: CC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+CPPKEYS.flags:
+	touch $(FCM_FLAGSDIR)/$@
+
+FC.flags:
+	touch $(FCM_FLAGSDIR)/$@
+
+FFLAGS.flags: FC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FPPKEYS.flags:
+	touch $(FCM_FLAGSDIR)/$@
+
+LD.flags:
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS.flags:
+	touch $(FCM_FLAGSDIR)/$@
+
+export OBJECTS = $(OBJECTS__IOIPSL) $(OBJECTS__MOZAIC) $(OBJECTS__POLY)
+
+libfcm_default.a: $(OBJECTS)
+	fcm_internal archive $@ $^
+
+FFLAGS__IOIPSL__calendar.flags: FFLAGS__IOIPSL.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+calendar.done: calendar.o errioipsl.done stringop.done
+	touch $(FCM_DONEDIR)/$@
+
+calendar.o: $(FCM_SRCDIR)/IOIPSL/calendar.f90 FFLAGS__IOIPSL__calendar.flags errioipsl.o stringop.o
+	fcm_internal compile:F IOIPSL $< $@
+
+FFLAGS__IOIPSL__defprec.flags: FFLAGS__IOIPSL.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+defprec.done: defprec.o
+	touch $(FCM_DONEDIR)/$@
+
+defprec.o: $(FCM_SRCDIR)/IOIPSL/defprec.f90 FFLAGS__IOIPSL__defprec.flags
+	fcm_internal compile:F IOIPSL $< $@
+
+FFLAGS__IOIPSL__errioipsl.flags: FFLAGS__IOIPSL.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+errioipsl.done: errioipsl.o
+	touch $(FCM_DONEDIR)/$@
+
+errioipsl.o: $(FCM_SRCDIR)/IOIPSL/errioipsl.f90 FFLAGS__IOIPSL__errioipsl.flags
+	fcm_internal compile:F IOIPSL $< $@
+
+FFLAGS__IOIPSL__fliocom.flags: FFLAGS__IOIPSL.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+fliocom.done: fliocom.o calendar.done defprec.done errioipsl.done stringop.done
+	touch $(FCM_DONEDIR)/$@
+
+fliocom.o: $(FCM_SRCDIR)/IOIPSL/fliocom.f90 FFLAGS__IOIPSL__fliocom.flags calendar.o defprec.o errioipsl.o stringop.o
+	fcm_internal compile:F IOIPSL $< $@
+
+FFLAGS__IOIPSL__getincom.flags: FFLAGS__IOIPSL.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+getincom.done: getincom.o errioipsl.done stringop.done
+	touch $(FCM_DONEDIR)/$@
+
+getincom.o: $(FCM_SRCDIR)/IOIPSL/getincom.f90 FFLAGS__IOIPSL__getincom.flags errioipsl.o stringop.o
+	fcm_internal compile:F IOIPSL $< $@
+
+FFLAGS__IOIPSL__stringop.flags: FFLAGS__IOIPSL.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+stringop.done: stringop.o
+	touch $(FCM_DONEDIR)/$@
+
+stringop.o: $(FCM_SRCDIR)/IOIPSL/stringop.f90 FFLAGS__IOIPSL__stringop.flags
+	fcm_internal compile:F IOIPSL $< $@
+
+FFLAGS__MOZAIC__allgrid.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__allgrid.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__allgrid.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+allgrid.exe: allgrid.o LD__MOZAIC__allgrid.flags LDFLAGS__MOZAIC__allgrid.flags declare.done dimensions.done mod_inipar.done mod_locio.done mod_prih.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+allgrid.o: $(FCM_SRCDIR)/MOZAIC/allgrid.f90 FFLAGS__MOZAIC__allgrid.flags declare.o dimensions.o mod_inipar.o mod_locio.o mod_prih.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__bord.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+bords.done: bords.o formula.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+bords.o: $(FCM_SRCDIR)/MOZAIC/bord.f90 FFLAGS__MOZAIC__bord.flags formula.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__build_poly.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_build.done: mod_build.o declare.done u_polyg.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_build.o: $(FCM_SRCDIR)/MOZAIC/build_poly.f90 FFLAGS__MOZAIC__build_poly.flags declare.o u_polyg.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__calving.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__calving.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__calving.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+calving.exe: calving.o LD__MOZAIC__calving.flags LDFLAGS__MOZAIC__calving.flags bords.done declare.done errioipsl.done fliocom.done formula.done getincom.done math.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_prih.done mod_rectifie.done mod_wri_wei.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+calving.o: $(FCM_SRCDIR)/MOZAIC/calving.f90 FFLAGS__MOZAIC__calving.flags bords.o declare.o errioipsl.o fliocom.o formula.o getincom.o math.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_prih.o mod_rectifie.o mod_wri_wei.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__chrono.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+chrono.done: chrono.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+chrono.o: $(FCM_SRCDIR)/MOZAIC/chrono.f90 FFLAGS__MOZAIC__chrono.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__correct.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+correct_a2o.done: correct_a2o.o
+	touch $(FCM_DONEDIR)/$@
+
+correct_a2o.o: $(FCM_SRCDIR)/MOZAIC/correct.f90 FFLAGS__MOZAIC__correct.flags
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__correction.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_correct.done: mod_correct.o modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_correct.o: $(FCM_SRCDIR)/MOZAIC/correction.f90 FFLAGS__MOZAIC__correction.flags modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__cotes.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__cotes.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__cotes.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+cote.o: $(FCM_SRCDIR)/MOZAIC/cotes.f90 FFLAGS__MOZAIC__cotes.flags bords.o declare.o errioipsl.o fliocom.o formula.o getincom.o math.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_norma.o mod_prih.o mod_rectifie.o mod_wri_wei.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+cotes.exe: cote.o LD__MOZAIC__cotes.flags LDFLAGS__MOZAIC__cotes.flags bords.done declare.done errioipsl.done fliocom.done formula.done getincom.done math.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_norma.done mod_prih.done mod_rectifie.done mod_wri_wei.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__cotes_a.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_cotes_a.done: mod_cotes_a.o declare.done formula.done math.done mod_lbc.done mod_polom.done mod_proj.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_cotes_a.o: $(FCM_SRCDIR)/MOZAIC/cotes_a.f90 FFLAGS__MOZAIC__cotes_a.flags declare.o formula.o math.o mod_lbc.o mod_polom.o mod_proj.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__cotes_etal.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__cotes_etal.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__cotes_etal.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+cotes_etal.exe: cotes_etal.o LD__MOZAIC__cotes_etal.flags LDFLAGS__MOZAIC__cotes_etal.flags bords.done declare.done errioipsl.done fliocom.done formula.done getincom.done math.done mod_cotes_a.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_norma.done mod_prih.done mod_rectifie.done mod_wri_wei.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+cotes_etal.o: $(FCM_SRCDIR)/MOZAIC/cotes_etal.f90 FFLAGS__MOZAIC__cotes_etal.flags bords.o declare.o errioipsl.o fliocom.o formula.o getincom.o math.o mod_cotes_a.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_norma.o mod_prih.o mod_rectifie.o mod_wri_wei.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__data_types.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+data_types.done: data_types.o defprec.done
+	touch $(FCM_DONEDIR)/$@
+
+data_types.o: $(FCM_SRCDIR)/MOZAIC/data_types.f90 FFLAGS__MOZAIC__data_types.flags defprec.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__declare.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+declare.done: declare.o data_types.done defprec.done poly_types.done
+	touch $(FCM_DONEDIR)/$@
+
+declare.o: $(FCM_SRCDIR)/MOZAIC/declare.f90 FFLAGS__MOZAIC__declare.flags data_types.o defprec.o poly_types.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__dimension.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+dimensions.done: dimensions.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+dimensions.o: $(FCM_SRCDIR)/MOZAIC/dimension.f90 FFLAGS__MOZAIC__dimension.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__formula.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+formula.done: formula.o declare.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+formula.o: $(FCM_SRCDIR)/MOZAIC/formula.f90 FFLAGS__MOZAIC__formula.flags declare.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__icestream.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__icestream.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__icestream.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+icestream.exe: icestream.o LD__MOZAIC__icestream.flags LDFLAGS__MOZAIC__icestream.flags bords.done declare.done errioipsl.done fliocom.done formula.done getincom.done math.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_prih.done mod_rectifie.done mod_wri_wei.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+icestream.o: $(FCM_SRCDIR)/MOZAIC/icestream.f90 FFLAGS__MOZAIC__icestream.flags bords.o declare.o errioipsl.o fliocom.o formula.o getincom.o math.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_prih.o mod_rectifie.o mod_wri_wei.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__inipar.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_inipar.done: mod_inipar.o defprec.done dimensions.done errioipsl.done fliocom.done getincom.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_inipar.o: $(FCM_SRCDIR)/MOZAIC/inipar.f90 FFLAGS__MOZAIC__inipar.flags defprec.o dimensions.o errioipsl.o fliocom.o getincom.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__inter.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_inter.done: mod_inter.o mod_lbc.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_inter.o: $(FCM_SRCDIR)/MOZAIC/inter.f90 FFLAGS__MOZAIC__inter.flags mod_lbc.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__interpol.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+declare_1.done: declare_1.o declare_1.done defprec.done errioipsl.done fliocom.done modele_1.done
+	touch $(FCM_DONEDIR)/$@
+
+declare_1.o: $(FCM_SRCDIR)/MOZAIC/interpol.f90 FFLAGS__MOZAIC__interpol.flags declare_1.o defprec.o errioipsl.o fliocom.o modele_1.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__inv_wei.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__inv_wei.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__inv_wei.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+inv_wei.exe: inv_wei.o LD__MOZAIC__inv_wei.flags LDFLAGS__MOZAIC__inv_wei.flags data_types.done defprec.done errioipsl.done fliocom.done
+	fcm_internal load:F MOZAIC $< $@
+
+inv_wei.o: $(FCM_SRCDIR)/MOZAIC/inv_wei.f90 FFLAGS__MOZAIC__inv_wei.flags data_types.o defprec.o errioipsl.o fliocom.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__isf_icb.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__isf_icb.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__isf_icb.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+isf_icb.exe: isf_icb.o LD__MOZAIC__isf_icb.flags LDFLAGS__MOZAIC__isf_icb.flags bords.done declare.done errioipsl.done fliocom.done formula.done getincom.done math.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_prih.done mod_rectifie.done mod_wri_wei.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+isf_icb.o: $(FCM_SRCDIR)/MOZAIC/isf_icb.f90 FFLAGS__MOZAIC__isf_icb.flags bords.o declare.o errioipsl.o fliocom.o formula.o getincom.o math.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_prih.o mod_rectifie.o mod_wri_wei.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__lbc.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_lbc.done: mod_lbc.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_lbc.o: $(FCM_SRCDIR)/MOZAIC/lbc.f90 FFLAGS__MOZAIC__lbc.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__lbc1.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_lbc_1.done: mod_lbc_1.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_lbc_1.o: $(FCM_SRCDIR)/MOZAIC/lbc1.f90 FFLAGS__MOZAIC__lbc1.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__lbc2.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_lbc_2.done: mod_lbc_2.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_lbc_2.o: $(FCM_SRCDIR)/MOZAIC/lbc2.f90 FFLAGS__MOZAIC__lbc2.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__lecdata.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_lecdata.done: mod_lecdata.o declare.done errioipsl.done fliocom.done mod_locio.done mod_prih.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_lecdata.o: $(FCM_SRCDIR)/MOZAIC/lecdata.f90 FFLAGS__MOZAIC__lecdata.flags declare.o errioipsl.o fliocom.o mod_locio.o mod_prih.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__lecw.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+d1.done: d1.o com1.done d1.done locio2.done
+	touch $(FCM_DONEDIR)/$@
+
+d1.o: $(FCM_SRCDIR)/MOZAIC/lecw.f90 FFLAGS__MOZAIC__lecw.flags com1.o d1.o locio2.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__lmdz.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__lmdz.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__lmdz.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+lmdgrille.o: $(FCM_SRCDIR)/MOZAIC/lmdz.f90 FFLAGS__MOZAIC__lmdz.flags declare.o dimensions.o errioipsl.o fliocom.o getincom.o mod_inipar.o mod_prih.o
+	fcm_internal compile:F MOZAIC $< $@
+
+lmdz.exe: lmdgrille.o LD__MOZAIC__lmdz.flags LDFLAGS__MOZAIC__lmdz.flags declare.done dimensions.done errioipsl.done fliocom.done getincom.done mod_inipar.done mod_prih.done
+	fcm_internal load:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__locio.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_locio.done: mod_locio.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_locio.o: $(FCM_SRCDIR)/MOZAIC/locio.f90 FFLAGS__MOZAIC__locio.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__math.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+math.done: math.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+math.o: $(FCM_SRCDIR)/MOZAIC/math.f90 FFLAGS__MOZAIC__math.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__modeles.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+modeles.done: modeles.o declare.done dimensions.done mod_prih.done
+	touch $(FCM_DONEDIR)/$@
+
+modeles.o: $(FCM_SRCDIR)/MOZAIC/modeles.f90 FFLAGS__MOZAIC__modeles.flags declare.o dimensions.o mod_prih.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__mosaic.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__mosaic.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__mosaic.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mosaic.exe: mosaic.o LD__MOZAIC__mosaic.flags LDFLAGS__MOZAIC__mosaic.flags bords.done errioipsl.done fliocom.done formula.done getincom.done math.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_locio.done mod_neuf.done mod_norma.done mod_polom.done mod_polyw_a.done mod_polyw_o.done mod_prih.done mod_proj.done mod_rectifie.done mod_wri_wei.done mod_wripoly.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+mosaic.o: $(FCM_SRCDIR)/MOZAIC/mosaic.f90 FFLAGS__MOZAIC__mosaic.flags bords.o errioipsl.o fliocom.o formula.o getincom.o math.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_locio.o mod_neuf.o mod_norma.o mod_polom.o mod_polyw_a.o mod_polyw_o.o mod_prih.o mod_proj.o mod_rectifie.o mod_wri_wei.o mod_wripoly.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__neuf.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_neuf.done: mod_neuf.o declare.done formula.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_neuf.o: $(FCM_SRCDIR)/MOZAIC/neuf.f90 FFLAGS__MOZAIC__neuf.flags declare.o formula.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__norma.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_norma.done: mod_norma.o declare.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_norma.o: $(FCM_SRCDIR)/MOZAIC/norma.f90 FFLAGS__MOZAIC__norma.flags declare.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__norma2.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+norma.done: norma.o declare.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+norma.o: $(FCM_SRCDIR)/MOZAIC/norma2.f90 FFLAGS__MOZAIC__norma2.flags declare.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__polom.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_polom.done: mod_polom.o declare.done mod_build.done u_polyg.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_polom.o: $(FCM_SRCDIR)/MOZAIC/polom.f90 FFLAGS__MOZAIC__polom.flags declare.o mod_build.o u_polyg.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__polyw_a.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_polyw_a.done: mod_polyw_a.o declare.done formula.done math.done mod_lbc.done mod_polom.done mod_proj.done modeles.done u_polyg.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_polyw_a.o: $(FCM_SRCDIR)/MOZAIC/polyw_a.f90 FFLAGS__MOZAIC__polyw_a.flags declare.o formula.o math.o mod_lbc.o mod_polom.o mod_proj.o modeles.o u_polyg.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__polyw_a_fast.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_polyw_a_fast.done: mod_polyw_a_fast.o declare.done formula.done math.done mod_proj.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_polyw_a_fast.o: $(FCM_SRCDIR)/MOZAIC/polyw_a_fast.f90 FFLAGS__MOZAIC__polyw_a_fast.flags declare.o formula.o math.o mod_proj.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__polyw_o.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_polyw_o.done: mod_polyw_o.o declare.done formula.done math.done mod_lbc.done mod_polom.done mod_proj.done modeles.done u_polyg.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_polyw_o.o: $(FCM_SRCDIR)/MOZAIC/polyw_o.f90 FFLAGS__MOZAIC__polyw_o.flags declare.o formula.o math.o mod_lbc.o mod_polom.o mod_proj.o modeles.o u_polyg.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__prih.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_prih.done: mod_prih.o declare.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_prih.o: $(FCM_SRCDIR)/MOZAIC/prih.f90 FFLAGS__MOZAIC__prih.flags declare.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__proj.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_proj.done: mod_proj.o declare.done u_polyg.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_proj.o: $(FCM_SRCDIR)/MOZAIC/proj.f90 FFLAGS__MOZAIC__proj.flags declare.o u_polyg.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__readw.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__readw.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__readw.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+readw.exe: readw.o LD__MOZAIC__readw.flags LDFLAGS__MOZAIC__readw.flags
+	fcm_internal load:F MOZAIC $< $@
+
+readw.o: $(FCM_SRCDIR)/MOZAIC/readw.f90 FFLAGS__MOZAIC__readw.flags
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__rectifie.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_rectifie.done: mod_rectifie.o declare.done formula.done mod_lbc.done mod_prih.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_rectifie.o: $(FCM_SRCDIR)/MOZAIC/rectifie.f90 FFLAGS__MOZAIC__rectifie.flags declare.o formula.o mod_lbc.o mod_prih.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__time.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+declare_2.done: declare_2.o declare_2.done defprec.done errioipsl.done fliocom.done modele_2.done
+	touch $(FCM_DONEDIR)/$@
+
+declare_2.o: $(FCM_SRCDIR)/MOZAIC/time.f90 FFLAGS__MOZAIC__time.flags declare_2.o defprec.o errioipsl.o fliocom.o modele_2.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__tst_field.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__tst_field.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__tst_field.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+tst_field.exe: tst_field.o LD__MOZAIC__tst_field.flags LDFLAGS__MOZAIC__tst_field.flags declare.done errioipsl.done fliocom.done formula.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_locio.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+tst_field.o: $(FCM_SRCDIR)/MOZAIC/tst_field.f90 FFLAGS__MOZAIC__tst_field.flags declare.o errioipsl.o fliocom.o formula.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_locio.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__tst_prec.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__tst_prec.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__tst_prec.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+tst_prec.exe: tst_prec.o LD__MOZAIC__tst_prec.flags LDFLAGS__MOZAIC__tst_prec.flags
+	fcm_internal load:F MOZAIC $< $@
+
+tst_prec.o: $(FCM_SRCDIR)/MOZAIC/tst_prec.f90 FFLAGS__MOZAIC__tst_prec.flags
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__tstmosaic.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LDFLAGS__MOZAIC__tstmosaic.flags: LDFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+LD__MOZAIC__tstmosaic.flags: LD__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+tstmosaic.exe: tstmosaic.o LD__MOZAIC__tstmosaic.flags LDFLAGS__MOZAIC__tstmosaic.flags bords.done declare.done errioipsl.done fliocom.done formula.done mod_inipar.done mod_inter.done mod_lbc.done mod_lecdata.done mod_locio.done modeles.done
+	fcm_internal load:F MOZAIC $< $@
+
+tstmosaic.o: $(FCM_SRCDIR)/MOZAIC/tstmosaic.f90 FFLAGS__MOZAIC__tstmosaic.flags bords.o declare.o errioipsl.o fliocom.o formula.o mod_inipar.o mod_inter.o mod_lbc.o mod_lecdata.o mod_locio.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__util.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_util.done: mod_util.o
+	touch $(FCM_DONEDIR)/$@
+
+mod_util.o: $(FCM_SRCDIR)/MOZAIC/util.f90 FFLAGS__MOZAIC__util.flags
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__wri_wei.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_wri_wei.done: mod_wri_wei.o errioipsl.done fliocom.done formula.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_wri_wei.o: $(FCM_SRCDIR)/MOZAIC/wri_wei.f90 FFLAGS__MOZAIC__wri_wei.flags errioipsl.o fliocom.o formula.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__MOZAIC__wripoly.flags: FFLAGS__MOZAIC.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mod_wripoly.done: mod_wripoly.o declare.done mod_proj.done modeles.done
+	touch $(FCM_DONEDIR)/$@
+
+mod_wripoly.o: $(FCM_SRCDIR)/MOZAIC/wripoly.f90 FFLAGS__MOZAIC__wripoly.flags declare.o mod_proj.o modeles.o
+	fcm_internal compile:F MOZAIC $< $@
+
+FFLAGS__POLY__m_g2d.flags: FFLAGS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+m_g2d.done: m_g2d.o mt_c2d.done poly_types.done
+	touch $(FCM_DONEDIR)/$@
+
+m_g2d.o: $(FCM_SRCDIR)/POLY/m_g2d.f90 FFLAGS__POLY__m_g2d.flags mt_c2d.o poly_types.o
+	fcm_internal compile:F POLY $< $@
+
+FFLAGS__POLY__mt_c2d.flags: FFLAGS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mt_c2d.done: mt_c2d.o poly_types.done
+	touch $(FCM_DONEDIR)/$@
+
+mt_c2d.o: $(FCM_SRCDIR)/POLY/mt_c2d.f90 FFLAGS__POLY__mt_c2d.flags poly_types.o
+	fcm_internal compile:F POLY $< $@
+
+FFLAGS__POLY__mt_polyg.flags: FFLAGS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+FPPKEYS__POLY__mt_polyg.flags: FPPKEYS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+mt_polyg.done: mt_polyg.o mt_c2d.done poly_types.done
+	touch $(FCM_DONEDIR)/$@
+
+mt_polyg.o: $(FCM_SRCDIR)/POLY/mt_polyg.F90 FFLAGS__POLY__mt_polyg.flags FPPKEYS__POLY__mt_polyg.flags mt_c2d.o poly_types.o
+	fcm_internal compile:F POLY $< $@ 1
+
+FFLAGS__POLY__poly_types.flags: FFLAGS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+poly_types.done: poly_types.o data_types.done defprec.done
+	touch $(FCM_DONEDIR)/$@
+
+poly_types.o: $(FCM_SRCDIR)/POLY/poly_types.f90 FFLAGS__POLY__poly_types.flags data_types.o defprec.o
+	fcm_internal compile:F POLY $< $@
+
+FFLAGS__POLY__u_graph.flags: FFLAGS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+u_graph.done: u_graph.o poly_types.done
+	touch $(FCM_DONEDIR)/$@
+
+u_graph.o: $(FCM_SRCDIR)/POLY/u_graph.f90 FFLAGS__POLY__u_graph.flags poly_types.o
+	fcm_internal compile:F POLY $< $@
+
+FFLAGS__POLY__u_polyg.flags: FFLAGS__POLY.flags
+	touch $(FCM_FLAGSDIR)/$@
+
+u_polyg.done: u_polyg.o m_g2d.done mt_polyg.done poly_types.done
+	touch $(FCM_DONEDIR)/$@
+
+u_polyg.o: $(FCM_SRCDIR)/POLY/u_polyg.f90 FFLAGS__POLY__u_polyg.flags m_g2d.o mt_polyg.o poly_types.o
+	fcm_internal compile:F POLY $< $@
+
+# EOF
Index: /TOOLS/MOZAIC/OLDIES/cotes.f90_20170616
===================================================================
--- /TOOLS/MOZAIC/OLDIES/cotes.f90_20170616	(revision 3326)
+++ /TOOLS/MOZAIC/OLDIES/cotes.f90_20170616	(revision 3326)
@@ -0,0 +1,1496 @@
+! -*- Mode: f90 -*-
+PROGRAM cote
+   USE declare
+   USE modeles
+   USE mod_lecdata
+   USE formula
+   USE math
+   USE mod_rectifie
+   USE mod_lbc
+   USE mod_norma
+   USE bords
+   USE mod_inter
+   USE mod_prih
+   USE mod_wri_wei
+   USE mod_inipar
+   USE fliocom
+   USE getincom
+   USE errioipsl
+!!!
+   IMPLICIT NONE
+!!!
+!!!   A partir d'un fichier de poids, complete avec les rivieres et
+!!!   les poids pour le run off
+   !! On met a zero les poids sur les points non cotiers, et on renormalise
+   !!
+   INTEGER (kind=il), PARAMETER :: jpr = 52 ! Nombre de rivieres
+   REAL (kind=rl) :: zsuma, zsumo
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: za
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zo
+   !!
+   CHARACTER (LEN = 1) :: clriv
+   CHARACTER (LEN = 30) :: clname
+   INTEGER (kind=il) :: ja, jo, jo2, jo3, jn, jno, joi, joj, jai, jaj, jr, kn  ! indices de boucle
+   INTEGER (kind=il) :: jai_p, jai_m, jaj_p, jaj_m, n1
+   INTEGER (kind=il) :: joi_p, joi_m, joj_p, joj_m
+   REAL (kind=rl) :: z_d_1, z_d_2, zzmin
+   INTEGER (kind=il) :: nriv = 32, nlmd = 35
+   INTEGER (kind=il), DIMENSION (:, :), ALLOCATABLE :: jx ! Point trouve sous une maille atm
+   INTEGER (kind=il) :: kom, ko
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: lacot, laland, laoce, lanoroute
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: locot, looce
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE  :: wtemp, d_cote
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: ktemp2
+   REAL(kind=rl), DIMENSION (:,:), ALLOCATABLE  :: wtemp2
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: iamsk
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: iomsk
+   INTEGER (kind=il) :: jovoid, jot, inum
+   CHARACTER (len=80) :: cfname4, cfname8
+   LOGICAL :: ltrouve, ltrouve2
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: itarget
+   REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: wtarget
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: i2a
+   INTEGER (kind=il) :: no, ntrouve
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: jo_n
+   LOGICAL :: l_fulldiag = .TRUE.
+   CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: tmask_atl, tmask_noclose, tmask_nomed, tmask_med
+   REAL(kind=rl), DIMENSION (:, :), ALLOCATABLE  :: z2o
+   CHARACTER (len=40) :: cl_bassin
+   INTEGER (kind=il) :: il_ncid
+   !!
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   INTEGER (kind=il) :: ierr
+   !!
+   !! Recherche voisins proches
+   INTEGER (kind=il) :: jp_nb
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: jo_tab
+   INTEGER (kind=il) :: jo_nb
+   !!
+   INTEGER :: nid_it
+   !!
+   CHARACTER (len = 50) :: cldiag_a2o, clw_a2o, clw_a2o_cdf, clw_a2o_mct
+   CHARACTER (len = 25) :: mo_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   CALL inipar
+   CALL alloc_modeles
+
+   !!
+   ALLOCATE (za      (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'za', lreset=.TRUE., crout='cotes')
+   ALLOCATE (zo      (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'zo')
+   ALLOCATE (jx      (jpo2a,2)   , STAT=ierr) ; CALL chk_allo (ierr, 'jx')
+   ALLOCATE (lacot   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'lacot')  ; lacot  = .FALSE.
+   ALLOCATE (laland  (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'laland') ; laland = .FALSE.
+   ALLOCATE (laoce   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'laoce')  ; laoce  = .FALSE.
+   !
+   ALLOCATE (locot   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'locot')  ; locot  = .FALSE.
+   ALLOCATE (looce   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'looce')  ; looce  = .FALSE.
+   !
+   ALLOCATE (ktemp   (jpa2o)     , STAT=ierr) ; CALL chk_allo (ierr, 'ktemp')
+   ALLOCATE (wtemp   (jpa2o)     , STAT=ierr) ; CALL chk_allo (ierr, 'wtemp')
+   ALLOCATE (iamsk   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'iamsk')
+   ALLOCATE (iomsk   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'iomsk')
+   ALLOCATE (d_cote  (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'd_cote')
+   !
+   ALLOCATE (itarget (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'itarget')
+   ALLOCATE (wtarget (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'wtarget')
+   ALLOCATE (i2a     (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'i2a')
+   !
+   ALLOCATE (tmask_atl     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_atl')
+   ALLOCATE (tmask_noclose (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_noclose')
+   ALLOCATE (tmask_nomed   (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmasl_nomed')
+   ALLOCATE (tmask_med     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_med')
+   ALLOCATE (z2o (jpoi, jpoj), STAT=ierr)     ; CALL chk_allo (ierr, 'z2o')
+   !
+   jp_nb = jpon
+   ALLOCATE (jo_tab (jpon)) ; CALL chk_allo (ierr, 'jo_tab')
+   !
+   IF (l_limit_iosize) l_fulldiag = .FALSE.
+   !!
+   !! Initialisation
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13 ; nchk = 14 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 81 ; nwei8o2a = 82 ; nwei4a2o = 83 ; nwei8a2o = 84
+   !
+   nout = 6
+   IF (nout /= 6 .AND. nout /= 0 ) &
+      & OPEN (unit = nout, file = 'cote' // TRIM(c_suffix) // '.out', action = 'WRITE', status = 'unknown', position = 'REWIND' )
+   !!
+   !! Diagnostics files
+   !!
+   IF (nout /= 6 ) &
+      &  OPEN (unit = nout, file = 'cotes' // TRIM(c_suffix) // '.out', position = 'REWIND', action = 'WRITE', status = 'replace' )
+   !!
+   !! Read coordinates of all models, and weights
+   !!
+   CALL lecdata (lecweights = .TRUE., leco2amask = .TRUE. )
+
+   !! Lecture masques de bassin
+   IF ( TRIM (cotyp) == 'orca4' .OR. &
+      & TRIM (cotyp) == 'orca2' .OR. TRIM (cotyp) == 'orca2.0' .OR. TRIM (cotyp) == 'orca2.1' .OR. TRIM (cotyp) == 'orca2.3' .OR. &
+      & TRIM (cotyp) == 'orca1' &
+      & ) THEN 
+      cl_bassin = TRIM (cotyp)
+!-$$      IF (c_period /= 'none' ) cl_bassin = TRIM (cl_bassin) // TRIM (c_period)
+      cl_bassin = TRIM (cl_bassin) // '.nc'
+      WRITE (nout,*) 'Reading bassin masks in : ', TRIM (cl_bassin)
+      CALL flioopfd (TRIM (cl_bassin), il_ncid )
+      CALL fliogetv (il_ncid, 'mask_atl'    , z2o )
+      tmask_atl = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_noclose', z2o )
+      tmask_noclose = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_nomed'  , z2o )
+      tmask_nomed = RESHAPE (z2o, (/ jpon /) )
+      CALL flioclo (il_ncid)
+   ELSE
+      tmask_atl     = REAL (1-iomskt, rl)
+      tmask_noclose = REAL (1-iomskt, rl)
+      tmask_nomed   = REAL (1-iomskt, rl)
+   END IF
+   !
+   WRITE (unit=nout, fmt=*) 'iomskt'
+   CALL prihin (RESHAPE(iomskt             ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_atl'
+   CALL prihin (RESHAPE(NINT(tmask_atl)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_med'
+   !CALL prihin (RESHAPE(NINT(tmask_med)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_noclose'
+   !CALL prihin (RESHAPE(NINT(tmask_noclose),(/jpoi,jpoj/)), 1_il, nout)
+   !
+   ! Set correct periodicity to grids
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+   CALL lbc (xalont, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalonu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalonv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !!
+   CALL rectifie
+   !!
+   CALL fliocrfd ('itarget' // TRIM(c_suffix), (/'x', 'y'/), (/jpai, jpaj/), nid_it, mode='REPLACE')
+   CALL flioputa (nid_it, "?", "title"         , "itarget" )
+   CALL flioputa (nid_it, '?', 'Comment', TRIM(c_comment) )
+   CALL DATE_AND_TIME (c_date, c_time, c_zone )
+   CALL flioputa (nid_it, "?", "history"       , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"// &
+      & c_date(7:8)//" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) )
+   CALL flioputa (nid_it, "?", "method"        , "MOSAIC" )
+   CALL flioputa (nid_it, "?", "source_grid"   , "curvilinear" )
+   CALL flioputa (nid_it, "?", "dest_grid"     , "curvilinear" )
+   CALL flioputa (nid_it, "?", "Institution"   , "IPSL" )
+   CALL flioputa (nid_it, "?", "Model"         , "IPSL CM6" )
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME", VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_it, "?", "HOSTNAME"     , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $HOSTNAME'
+   END IF
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_it, "?", "LOGNAME"      , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $LOGNAME'
+   END IF
+
+   CALL fliodefv (nid_it, 'lon', (/1, 2/), units="degree_north", v_t=flio_r4 )
+   CALL fliodefv (nid_it, 'lat', (/1, 2/), units="degree_east",  v_t=flio_r4 )
+   CALL fliodefv (nid_it, 'o2amask', (/1,2/), v_t=flio_r4)
+   CALL fliodefv (nid_it, 'laland', (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'lacot' , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'laoce' , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'iamskp', (/1,2/), v_t=flio_i4)
+
+   CALL flioputv (nid_it, 'lon'    , RESHAPE ( xalont, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'lat'    , RESHAPE ( xalatt, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'o2amask', RESHAPE (o2amask, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'iamskp' , RESHAPE (iamskp , (/jpai, jpaj/)) )
+   !!
+   !! Compute edges of grid boxes
+   !!
+   CALL bord_a
+   CALL bord_o
+   CALL bord_oa
+   !!
+   mo_name  = "mozaic"
+   a2o_name = "a2o"
+   !!
+   WRITE (nout,*) 'o2amask (>0, <=0, >1) ', COUNT (o2amask >  0.0_rl), COUNT (o2amask <= 0.0_rl) &
+      &                     , COUNT (o2amask >= 1.0_rl)
+   i2a = 0_il
+   WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) 
+      i2a = 1_il
+   END WHERE
+   WRITE (nout, *) 'i2a (o2amask > 0)'
+   CALL prihin (i2a , 1_il, nout)
+   !!
+   !! Verif poids avant reduction
+   !!
+   WRITE (unit=nout,fmt=*) 'Verif poids globale'
+   za = 0.0_rl
+   WRITE (nout, *) 'Comptage xasrft  ' , COUNT ( xasrft < 1.0E-10_rl )
+   WRITE (nout, *) 'Comptage o2amask ' , COUNT ( o2amask < 0.5_rl )
+   WHERE ( xasrft * o2amask /= 0.0_rl )
+      za = 1.0_rl / (xasrft * o2amask)
+   END WHERE
+   WRITE (nout, *) 'Somme za     ', SUM ( za)
+   WRITE (nout, *) 'Somme xasrft ', SUM ( xasrft)
+   zsuma = DOT_PRODUCT (za, xasrft * o2amask)
+   !!
+   WRITE (nout, *) 'jma2o for coastal runoff : ', jma2o
+   !! Atm mask interpolated to oce
+   za = REAL (1_il-iamskt, KIND = rl )
+   CALL inter_a2o (za, a2omask )
+   !! 1 on Atm interpolated to oce
+   za = REAL (1_il       , KIND = rl )
+   CALL inter_a2o (za, a2ofull )
+   !!
+   CALL verif ('Apres lecture')
+   !!
+   CALL bilan ("Poids ", c_case="complet", c_int_atm="Local", c_int_oce="Local")
+   CALL bilan ("Poids ", c_case="ocean"  , c_int_atm="Local", c_int_oce="Local")
+   !!
+   !! Remise des poids en integre
+   DO jn = 1, jpa2o
+      DO jo = 1, jpon
+         ja = ka2o (jn, jo)
+         IF (ja > 0) THEN 
+            IF ( o2amask (ja) .GT. 0.0_rl) &
+               & wa2o (jn, jo) = wa2o (jn, jo) * xosrft (jo) / ( xasrft (ja) * o2amask (ja))
+         END IF
+      END DO
+   END DO
+   !
+   CALL bilan ("Integre ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+   CALL bilan ("Integre ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+   CALL bilan ("Integre ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+   !!
+   E_DRYRUN: IF (l_dryrun) THEN
+      WRITE (nout,*) "Remplissage bidon des champs pour tester les I/O"
+      jma2o = jma2or
+      nvo = jma2or
+      WRITE (nout,*) 'jma2o pour test : ', jma2o
+      CALL RANDOM_SEED
+      CALL RANDOM_NUMBER (wa2o) ; ka2o = NINT (wa2o*REAL(jpan,rl) )
+
+      DO jo = 1, jpon
+         IF ( iomskt (jo) == 1 ) THEN
+            wa2o (:, jo) = 0.0_rl
+            ka2o (:, jo) = 0_il
+         END IF
+      END DO
+
+      DO jo = 1, jpon
+         DO jno = 1, jpa2o
+            ja = ka2o (jno, jo)
+            IF (ja > 0) THEN 
+               IF (iamskt (ja) == 1) THEN
+                  wa2o (jno, jo) = 0.0_rl ; ka2o (jno, jo) = 0_il
+               END IF
+            END IF
+         END DO
+      END DO
+   ELSE
+      L_lcoast: IF (lcoast) THEN
+         !! Dataset 4 : idem 2, mais en interpolant seulement des points cotes atmosphere vers
+         !! les points cotes ocean.
+         WRITE (nout,*) 'Demarrage L_coast'
+         !!
+         WRITE (nout,*) 'Calculs points terre/oce/cote sur grille atmosphere'
+         WHERE (o2amask .LT. epsfrac                                     ) laland = .TRUE.
+         WHERE (o2amask .GE. epsfrac .AND. o2amask .LE. (1.0_rl-epsfrac) ) lacot  = .TRUE.
+         WHERE (                           o2amask .GT. (1.0_rl-epsfrac) ) laoce  = .TRUE.
+
+         WRITE (UNIT=nout, FMT=*) 'Points cotiers ', COUNT(lacot)
+
+         WRITE (nout,*) 'Ecriture '
+         i2a = 0
+         WHERE (RESHAPE(laland,(/jpai,jpaj/))) i2a=1
+         CALL flioputv (nid_it, "laland", i2a)
+         i2a = 0
+         WHERE (RESHAPE(laoce ,(/jpai,jpaj/))) i2a=1 
+         CALL flioputv (nid_it, "laoce", i2a)
+         i2a = 0
+         WHERE (RESHAPE(lacot ,(/jpai,jpaj/))) i2a=1
+         CALL flioputv (nid_it, "lacot", i2a)
+
+         WRITE (nout,*) 'Determination des points cotes ocean '
+         ALLOCATE (ktemp2(jpoi,jpoj))
+         ktemp2 = 0_il
+         locot = .FALSE.
+         looce = .FALSE.
+         IF ( lcoast ) THEN 
+            DO jo = 1, jpon
+               joi = moi (jo) ; joj = moj (jo) ! Indices 2D
+               joi_p = joi+1            ; joi_m = joi-1
+               joj_p = MIN(joj+1, jpoj) ; joj_m = MAX (joj-1, 1)
+               IF ( iomskt (jo) == 0_il .AND. iomskp (jo) == 0_il ) THEN
+                  IF (    iomskt (m1o (joi_p, joj  )) == 1  &
+                     .OR. iomskt (m1o (joi_m, joj  )) == 1  &
+                     .OR. iomskt (m1o (joi  , joj_p)) == 1  &
+                     .OR. iomskt (m1o (joi  , joj_m)) == 1  &
+                     .OR. iomskt (m1o (joi_p, joj_p)) == 1  &
+                     .OR. iomskt (m1o (joi_p, joj_m)) == 1  &
+                     .OR. iomskt (m1o (joi_m, joj_p)) == 1  &
+                     .OR. iomskt (m1o (joi_m, joj_m)) == 1  ) THEN
+                     locot (jo) = .TRUE.
+                     ktemp2 (joi, joj) = 1_il
+                  ELSE 
+                     looce (jo) = .TRUE.
+                  END IF
+               END IF
+            END DO
+         ELSE
+            locot (:) = ( iomskt == 0 )
+         ENDIF
+         CALL lbc (locot, noperio, 'T', jpoi, jpoj)
+         CALL lbc (looce, noperio, 'T', jpoi, jpoj)
+         WRITE (nout,*) "iomskt"
+         CALL prihin (RESHAPE(iomskt,(/jpoi,jpoj/)), 1, nout)
+         WRITE (nout,*) "Locot"
+         CALL prihin (ktemp2, 1, nout)
+         DEALLOCATE (ktemp2)
+         WRITE (nout,*) 'Verif coherence (tout doit etre nul)'
+         WRITE (nout,*) COUNT ( laland .AND. lacot)
+         WRITE (nout,*) COUNT ( lacot  .AND. laoce)
+         WRITE (nout,*) COUNT ( laoce  .AND. laland)
+         WRITE (nout,*) COUNT ( .NOT. ( laland .OR. lacot .OR. laoce) )
+
+!-$$      iamsk = 0 ; WHERE (lacot) iamsk = 1
+!-$$      WRITE(nout,*) 'Fraction lacot'
+!-$$      CALL prihin(RESHAPE(iamsk,(/jpai,jpaj/)),1_il,nout)
+!-$$
+!-$$      iamsk = 0 ; WHERE (laland) iamsk = 1
+!-$$      WRITE(nout,*) 'Points avec terre laland'
+!-$$      CALL prihin(RESHAPE(iamsk,(/jpai,jpaj/)),1_il,nout)
+!-$$
+!-$$      iamsk = 0 ; WHERE (laoce) iamsk = 1
+!-$$      WRITE(nout,*) 'Fraction laoce'
+!-$$      CALL prihin(RESHAPE(iamsk,(/jpai,jpaj/)),1_il,nout)
+!-$$
+!-$$      WRITE(nout,*) 'Periodicite atm'
+!-$$      CALL prihin(RESHAPE(iamskp,(/jpai,jpaj/)),1_il,nout)
+         !!
+         WRITE (nout,*) "iamskt"
+         CALL prihin (RESHAPE(iamskt,(/jpai,jpaj/)), 1, nout)
+         WRITE (nout,*) "Lacot"
+         ALLOCATE (ktemp2 (jpai, jpaj))
+         ktemp2 = 0_il ; WHERE (RESHAPE(lacot, (/jpai, jpaj/))) ktemp2 = 1_il
+         CALL prihin (ktemp2, 1, nout)
+         !!
+         WRITE (unit = nout, fmt = *) 'Nombre de points cotes atmosphere : ', COUNT (lacot)
+         WRITE (unit = nout, fmt = *) 'Nombre de points cotes ocean      : ', COUNT (locot)
+         !!
+         CALL bilan ("Avec cote ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Avec cote ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Avec cote ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+         !
+         ! Mise a zero des poids sur les points non cotiers
+         DO jo = 1, jpon
+            IF (.NOT. locot (jo)             ) THEN
+               wa2o (:, jo) = 0.0e0_rl
+               ka2o (:, jo) = 0_il
+            ELSE
+               DO jn = 1, jpa2o
+                  ja = ka2o (jn, jo)
+                  IF (ja > 0 ) THEN
+                     IF (.NOT. lacot (ja) ) THEN
+                        wa2o (jn, jo) = 0.0e0_rl
+                        ka2o (jn, jo) = 0_il
+                     END IF
+                  END IF
+               END DO
+            END IF
+         END DO
+         CALL verif ('Apres remise a zero')
+         !!
+         !! Elimination des points redondant par periodicite
+         DO jo = 1, jpon
+            IF (iomskp (jo) .EQ. 1_il ) THEN
+               wa2o (:,jo) = 0.0e0_rl
+               ka2o (:,jo) = 0_il
+            END IF
+         END DO
+         !!
+         !! Controle
+         !! 
+         CALL verif ('Apres elimination de periodicite')
+         !!
+         CALL bilan ("Apres remise a zero ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+         !!
+         !! Renormalize
+         ! Cas 1 
+         RenormA : DO ja = 1, jpan
+            IF (.NOT. lacot (ja) ) CYCLE RenormA
+            z_d_1 = 0.0e0_rl
+            kom = 0
+            RenormO : DO jo = 1, jpon
+               IF (.NOT. locot (jo) ) CYCLE RenormO
+               DO jn = 1, jpa2o
+                  IF ( ka2o (jn,jo) == ja ) THEN
+                     z_d_1 = z_d_1 + wa2o (jn,jo) 
+                     kom = kom + 1
+                     jx (kom,:) = (/ jn, jo /)
+                     !!$ WRITE (unit = nout, fmt = '(6I6,16F18.6) ') ja, jo, jn, kom, jx (kom, :), &
+                     !!$   wa2o (jn,jo), wa2o (jx (kom, 1), jx (kom, 2)), z_d_1, &
+                     !!$   xosrft (jo), xasrft (ja)
+                  END IF
+               END DO
+            ENDDO RenormO
+            IF (kom /= 0 ) THEN
+               IF (z_d_1 == 0.0_rl ) THEN
+                  WRITE (nout, *) 'z_d_1 nul ', ja, xasrft (ja), lacot (ja), iamskt (ja), &
+                     & wa2o (:,ja), ka2o (:,ja)
+                  STOP
+               ELSE
+                  DO ko = 1, kom
+                     wa2o (jx (ko,1), jx (ko,2)) = wa2o (jx (ko,1), jx (ko,2)) / z_d_1
+                  END DO
+               ENDIF
+            END IF
+         ENDDO RenormA
+         !!
+         !! Calcul des distances à la cote des points oceans
+!-$$      WRITE (nout,*) 'Distance cotes'
+!-$$      d_cote = rpi
+!-$$      Cal_dist_1: DO jo = 1, jpon
+!-$$         IF ( iomskt (jo) == 1 .OR. locot (jo) ) THEN 
+!-$$            d_cote (jo) = 0.0E0_rl
+!-$$         ELSE
+!-$$            Cal_dist_2:DO jo2 = 1, jpon
+!-$$               IF ( locot (jo2) ) THEN 
+!-$$                  d_cote (jo) = MIN (d_cote (jo),  REAL (geodist(xolont(jo), xolatt(jo), xolont(jo2), xolatt(jo2)), KIND=rl))
+!-$$               END IF
+!-$$            END DO Cal_dist_2
+!-$$         END IF
+!-$$      END DO Cal_dist_1
+!-$$      d_cote = d_cote * r_earth
+         !CALL prihre (RESHAPE(d_cote,(/jpoi,jpoj/)), 1.0E-5_rl, nout)
+         WRITE (nout,*) 'Distance maxi a la cote (ocean) : ', MAXVAL (d_cote)
+         CALL fliocrfd ("dist_cote" // TRIM(c_suffix), (/ "x", "y"/), (/jpoi, jpoj/), n1, MODE="REPLACE")
+         CALL flioputa (n1, '?', 'Comment', TRIM(c_comment) )
+         CALL fliodefv (n1, "dist_cote", (/1, 2/))
+         CALL flioputv (n1, "dist_cote", RESHAPE (d_cote, (/jpoi, jpoj/) ))
+         CALL flioclo (n1)
+         !
+         !! Controle
+         !! 
+         CALL verif ('Premiere normalisation')
+         CALL gather_wei ('Premiere etape')
+         CALL verif ('Premier gather')
+         !!
+         CALL bilan ("Renorm ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Renorm ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Renorm ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+         !!
+         !! Traitement des points atmospheres non atteint
+         !!
+         total: IF (ltotal) THEN
+            WRITE (nout,*) 'Va chercher tout les points terre (ltotal=TRUE)'
+            SeekAtm_1_1: DO ja = 1, jpan
+!-$$            WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja), itarget(ja), iamskp(ja), laland(ja), lacot(ja), laoce(ja)
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_1_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_1_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_1_1
+               zzmin = REAL (cartdist(0.0_rl, 90.0_rl, 0.0_rl, -90.0_rl), KIND=rl)
+               ltrouve = .FALSE. ; jot = 0_il
+!-$$            WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_1_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (.NOT. locot (jo)    ) CYCLE SeekOce_1_1
+                  IF (iomskp(jo) .EQ. 1_il) CYCLE SeekOce_1_1
+                  z_d_1 =  REAL (cartdist(xalont(ja), xalatt(ja), xolont(jo), xolatt(jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1
+                     ltrouve = .TRUE. ; jot = jo
+                  END IF
+               ENDDO SeekOce_1_1
+               Trouve_1_1: IF (ltrouve) THEN
+                  ! Calcul du poids
+                  z_d_1 = 1.0_rl
+                  ! Rangement des poids
+                  IF (nvo (jot) < jpa2o ) THEN ! Reste un poids libre
+                     nvo (jot) = nvo (jot) + 1
+                     wa2o (nvo (jot), jot) = z_d_1
+                     ka2o (nvo (jot), jot) = ja
+!-$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                  ELSE ! Trouve12
+                     WRITE(nout,*) '  Plus de place ', ja, jot, nvo (jot), z_d_1
+                     STOP
+                  ENDIF
+               ELSE ! Trouve
+                  !! Message d'erreur
+                  WRITE (unit = nout, fmt = '("Pas de voisin proche pour ", 1I5,2I4)' ) ja, m2ai(ja), m2aj(ja)
+               END IF Trouve_1_1
+            END DO SeekAtm_1_1
+            !!
+            CALL verif ('ltotal avant gather')
+            CALL bilan ("Ltotal avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total')
+            CALL verif ( 'Cas total', l_non_a=.TRUE.)
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total
+         !!
+         Total_dist: IF (ltotal_dist) THEN
+            !! On limite la recherche à une certaine distance de la cote.
+            WRITE (nout,*) 'Cas ltotal_dist'
+            SeekAtm_2_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_2_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_2_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_2_1
+               zzmin = dist_max
+               ltrouve = .FALSE. ; jot = 0_il
+               !$$$            WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_2_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (.NOT. locot (jo)    ) CYCLE SeekOce_2_1
+                  IF (iomskp(jo) .EQ. 1_il) CYCLE SeekOce_2_1
+                  z_d_1 =  r_earth * REAL (geodist(xalont(ja), xalatt(ja), xolont(jo), xolatt(jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1
+                     ltrouve = .TRUE. ; jot = jo
+                  END IF
+               ENDDO SeekOce_2_1
+               Trouve_2_1: IF (ltrouve) THEN
+                  ! Calcul du poids
+                  z_d_1 = 1.0_rl
+                  IF (nvo (jot) < jpa2o ) THEN ! Reste un poids libre
+                     nvo (jot) = nvo (jot) + 1
+                     wa2o (nvo (jot), jot) = z_d_1
+                     ka2o (nvo (jot), jot) = ja
+                     !$$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                  ELSE 
+                     WRITE(nout,*) '  Plus de place ', ja, jot, nvo (jot), z_d_1
+                     STOP
+                  ENDIF
+               END IF Trouve_2_1
+            END DO SeekAtm_2_1
+            !!
+            CALL verif ('Ltotal_dist avant gather')
+            CALL bilan ("Ltotal_dist avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total_dist')
+            CALL verif ( 'Cas total_dist')
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal_dist ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total_dist
+         !!
+         Total_dist_2: IF (ltotal_dist_2) THEN
+            !! On limite la recherche à une certaine distance de la cote.
+            !! On etale sur les point oceans cotiers proches
+            WRITE (nout,*) '-------------------'
+            WRITE (nout,*) 'Cas ltotal_dist_2'
+            WRITE (nout,*) 'Distance recherche        : ', dist_max/1.0E3_rl, 'km'
+            WRITE (nout,*) 'Distance etalement ocean  : ', dist_max_voisin/1.0E3_rl, 'km'
+            !!
+            SeekAtm_3_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_3_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_3_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_3_1
+               zzmin = dist_max
+               ltrouve = .FALSE. ; jot = 0_il ; ntrouve = 0
+               !WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_3_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (.NOT. locot (jo)     ) CYCLE SeekOce_3_1
+                  IF (iomskp (jo) .EQ. 1_il) CYCLE SeekOce_3_1
+                  z_d_1 =  r_earth * REAL (geodist (xalont (ja), xalatt (ja), xolont (jo), xolatt (jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1 ; ltrouve = .TRUE. ; jot = jo ; ntrouve = ntrouve+1
+                  END IF
+               ENDDO SeekOce_3_1
+               WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot, ntrouve
+               Trouve_3_1: IF (ltrouve) THEN
+                  ! On cherche les points proches du point ocean trouve
+                  z_d_1    = 0.0_rl ; jo_tab = 0 ; jo_nb  = 0
+                  SeekOce_3_2: DO jo2 = 1, jpon
+                     IF (.NOT. locot (jo2)     ) CYCLE SeekOce_3_2
+                     IF (iomskp (jo2) .EQ. 1_il) CYCLE SeekOce_3_2
+                     IF ( r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jo2), xolatt (jo2)), KIND=rl) &
+                        &    < dist_max_voisin) THEN 
+                        IF (jo_nb >= jp_nb) THEN
+                           WRITE (nout,*) 'Trop de point proches ', ja, jot, jo_tab 
+                           STOP
+                        ELSE
+                           jo_nb = jo_nb + 1
+                           z_d_1 = z_d_1 + xosrft (jo2)
+                           jo_tab (jo_nb) = jo2
+                        END IF
+                     END IF
+                     ! Calcul du poids
+                  END DO SeekOce_3_2
+                  IF (jo_nb == 0) THEN
+                     WRITE (nout,*) 'Pas de voisin au voisin ! ', ja, jot, m2oi(jot), m2oj(jot), xolont(jot), xolatt(jot)
+                     WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+                     WRITE (nout,*) r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jot), xolatt (jot)), KIND=rl)
+                     STOP
+                  ELSE
+!-$$                  WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot, jo_nb, jo_tab (1:jo_nb)
+                     DO jn = 1, jo_nb
+                        jo3 = jo_tab (jn)
+                        IF (nvo (jo3) < jpa2o ) THEN ! Reste un poids libre
+                           nvo (jo3) = nvo (jo3) + 1
+                           wa2o (nvo (jo3), jo3) = xosrft (jo3) / z_d_1
+                           ka2o (nvo (jo3), jo3) = ja
+                           !$$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                        ELSE 
+                           WRITE(nout,*) '  Plus de place ', ja, jo3, nvo (jo3), z_d_1
+                           STOP
+                        ENDIF
+                     END DO
+                  END IF
+!-$$               ELSE
+!-$$                  WRITE (nout,*) 'Pas de voisins proche trouve '
+!-$$                  WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+!-$$                  WRITE (nout,*) dist_max, zzmin, z_d_1
+!-$$                  !STOP
+               END IF Trouve_3_1
+            END DO SeekAtm_3_1
+            !!
+            CALL verif ('Ltotal_dist_2 avant gather')
+            CALL bilan ("Ltotal_dist_2 avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_2 avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_2 avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total_dist_2')
+            CALL verif ( 'Cas total_dist_2')
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal_dist_2 ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_2 ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_2 ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total_dist_2
+         !!
+         Total_dist_3: IF (ltotal_dist_3) THEN
+            !! On limite la recherche à une certaine distance de la cote.
+            !! On etale sur les point oceans proches, cote ou pas
+            WRITE (nout,*) '-------------------'
+            WRITE (nout,*) 'Cas ltotal_dist_3'
+            WRITE (nout,*) 'Distance recherche        : ', dist_max/1.0E3_rl, 'km'
+            WRITE (nout,*) 'Distance etalement ocean  : ', dist_max_voisin/1.0E3_rl, 'km'
+            !!
+            SeekAtm_4_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_4_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_4_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_4_1
+               zzmin = dist_max
+               ltrouve = .FALSE. ; jot = 0_il
+!-$$            WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_4_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (iomskp (jo) .EQ. 1_il .OR. iomskt (jo) .EQ. 1_il ) CYCLE SeekOce_4_1
+                  z_d_1 =  r_earth * REAL (geodist (xalont (ja), xalatt (ja), xolont (jo), xolatt (jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1 ; ltrouve = .TRUE. ; jot = jo
+                  END IF
+               ENDDO SeekOce_4_1
+!-$$            WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot
+               Trouve_4_1: IF (ltrouve) THEN
+                  ! On cherche les points proches du point ocean trouve, le long de la cote et vers le large
+                  z_d_1    = 0.0_rl ; jo_tab = 0 ; jo_nb  = 0
+                  SeekOce_4_2: DO jo2 = 1, jpon
+                     IF (iomskp (jo2) .EQ. 1_il .OR. iomskt (jo2) .EQ. 1_il) CYCLE SeekOce_4_2
+                     IF ( .NOT. l_large .AND. .NOT. locot (jo2)) CYCLE SeekOce_4_2
+                     z_d_2 =  r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jo2), xolatt (jo2)), KIND=rl)
+                     IF (      (       locot (jo2)  .AND. z_d_2 < dist_max_cote  ) & 
+                        .OR. ( .NOT. locot (jo2)  .AND. z_d_2 < dist_max_large ) ) THEN
+                        IF (jo_nb > jp_nb) THEN
+                           WRITE (nout,*) 'Trop de point proches ', ja, jot, jo_tab 
+                           STOP
+                        ELSE
+                           jo_nb = jo_nb + 1
+                           z_d_1 = z_d_1 + xosrft (jo2)
+                           jo_tab (jo_nb) = jo2
+                        END IF
+                     END IF
+                     ! Calcul du poids
+                  END DO SeekOce_4_2
+                  IF (jo_nb == 0) THEN
+                     WRITE (nout,*) 'Pas de voisin au voisin ! ', ja, jot, m2oi(jot), m2oj(jot), xolont(jot), xolatt(jot)
+                     WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+                     WRITE (nout,*) r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jot), xolatt (jot)), KIND=rl)
+                     STOP
+                  ELSE
+!-$$                  WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot, jo_nb, jo_tab (1:jo_nb)
+                     DO jn = 1, jo_nb
+                        jo3 = jo_tab (jn)
+                        IF (nvo (jo3) < jpa2o ) THEN ! Reste un poids libre
+                           nvo (jo3) = nvo (jo3) + 1
+                           wa2o (nvo (jo3), jo3) = xosrft (jo3) / z_d_1
+                           ka2o (nvo (jo3), jo3) = ja
+                           !$$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                        ELSE 
+                           WRITE(nout,*) '  Plus de place ', ja, jo3, nvo (jo3), z_d_1
+                           STOP
+                        ENDIF
+                     END DO
+                  END IF
+               ELSE
+                  WRITE (nout,*) 'Pas de voisins proche trouve '
+                  WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+                  WRITE (nout,*) dist_max, zzmin, z_d_1
+                  STOP
+               END IF Trouve_4_1
+            END DO SeekAtm_4_1
+            !!
+            CALL verif ('Ltotal_dist_3 avant gather')
+            CALL bilan ("Ltotal_dist_3 avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_3 avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_3 avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total_dist_3')
+            CALL verif ( 'Cas total_dist_3')
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal_dist_3 ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_3 ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_3 ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total_dist_3
+         !!
+         Essai: IF (lessai) THEN
+            WRITE (nout,*) '--- Methode essai ----'
+            no = COUNT ( laland .AND. (itarget == 0_il))
+            WRITE (nout,*) 'Nombre de points atm non vises : ', no
+            WRITE (nout,*) 'jma2o, jpa2o, jma2o+no ', jma2o, jpa2o, jma2o+no
+            IF ( jma2o + no .GT. jpa2o ) THEN
+               WRITE (nout, *) 'Pas assez de voisins pour la methode essai'
+               STOP
+            END IF
+            !! Liste des points oceans
+            no = COUNT ( looce .AND. iomskp == 0_il)
+            WRITE (nout,*) 'Nombre de points oce cibles : ', no
+            ALLOCATE ( jo_n (no), STAT=ierr) ; CALL chk_allo (ierr, 'jo_n')
+            !!
+            no = 0 ; z_d_1 = 0.0_rl
+            DO jo = 1, jpon
+               IF ( .NOT. looce (jo)   ) CYCLE
+               IF ( iomskp (jo) == 1 ) CYCLE
+               no = no + 1
+               jo_n (no) = jo
+               z_d_1 = z_d_1 + xosrft (jo)
+            END DO
+            no = COUNT ( looce .AND. iomskp == 0_il)
+            WRITE (nout,*) 'Surface : ', z_d_1
+            SeekAtm_5_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_5_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_5_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_5_1
+               DO kn = 1, no
+                  jo = jo_n (kn)
+                  IF (nvo (jo) < jpa2o ) THEN ! Reste un poids libre
+                     nvo (jo) = nvo (jo) + 1
+                     wa2o (nvo (jo), jo) = xosrft (jo) / z_d_1
+                     ka2o (nvo (jo), jo) = ja
+                  ELSE 
+                     WRITE(nout,*) '  Plus de place ', ja, jot, nvo (jot), z_d_1
+                     STOP
+                  ENDIF
+               END DO
+            END DO SeekAtm_5_1
+            !! 
+            CALL gather_wei ('apres essai')
+            !!
+            CALL verif ( 'Cas essai')
+            CALL bilan ("Lessai avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Lessai avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Lessai avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+         END IF Essai
+         !!
+         !! Traitement des points atmosphere en bord de cote
+         !!
+!-$$      IfNear: IF (lnear) THEN
+!-$$         WRITE (nout,*) 'Extension de 1 point a l''interieur, vers le point ocean le plus proche (lnear=TRUE)'
+!-$$         SeekAtm1: DO ja = 1, jpan
+!-$$            IF (.NOT. laland_bord(ja) ) CYCLE SeekAtm1
+!-$$            IF (iamskp(ja) .EQ. 1_il ) CYCLE SeekAtm1
+!-$$            IF (.NOT. laland(ja) ) CYCLE SeekAtm1
+!-$$            zzmin = REAL (geodist(0.0_rl, 90.0_rl, 0.0_rl, -90.0_rl), KIND=rl)
+!-$$            ltrouve = .FALSE. ; jot = 0_il
+!-$$            SeekOce1: DO jo = 1, jpon
+!-$$               IF (.NOT. locot(jo) ) CYCLE SeekOce1
+!-$$               IF (iomskp(jo) .EQ. 1_il ) CYCLE SeekOce1
+!-$$               z_d_1 =  REAL (geodist(xalont(ja), xalatt(ja), xolont(jo), xolatt(jo)), KIND=rl)
+!-$$               IF (z_d_1 .LT. zzmin) THEN 
+!-$$                  zzmin = z_d_1
+!-$$                  ltrouve = .TRUE. ; jot = jo
+!-$$               END IF
+!-$$            ENDDO SeekOce1
+!-$$            Trouve11: IF (ltrouve) THEN
+!-$$               WRITE (nout,*) 'Point oce proche ', jot, m2oi(jot), m2oj(jot)
+!-$$               !! Calcul du poids
+!-$$               z_d_1 = xasrft(ja)/xosrft(jot)
+!-$$               !! Rangement des poids
+!-$$               ! On cherche si ce point atm est deja vise par ce point ocean (normalement non)
+!-$$               ltrouve2 = .FALSE.
+!-$$               L11: DO jn = 1, jpa2o
+!-$$                  IF (ka2o(jn,jot) == ja ) THEN
+!-$$                     wa2o(jn,jot) =  wa2o(jn,jot) + z_d_1
+!-$$                     WRITE (nout,*) 'Ajout au point oce ', jo, m2oi(jo), m2oj(jo)
+!-$$                     ltrouve2 = .TRUE.
+!-$$                     EXIT L11
+!-$$                  ENDIF
+!-$$               ENDDO L11
+!-$$               Trouve12: IF (.NOT. ltrouve2 ) THEN
+!-$$                  IF (nvo(jot) < jpa2o ) THEN ! Reste un poids libre
+!-$$                     nvo(jot) = nvo(jot) + 1
+!-$$                     wa2o(nvo(jot),jot) = z_d_1
+!-$$                     ka2o(nvo(jot),jot) = ja
+!-$$                     WRITE (nout,*) 'Vers point oce ', jot, m2oi(jot), m2oj(jot)
+!-$$                  ELSE ! Trouve2
+!-$$                     WRITE(nout,*) 'Plus de place'
+!-$$                     STOP
+!-$$                  ENDIF
+!-$$               END IF Trouve12
+!-$$            ELSE ! Trouve
+!-$$               !! Message d'erreur
+!-$$               WRITE (unit = nout, fmt = '("Pas de voisin proche pour ", 1I5,2I4)' ) ja, m2ai(ja), m2aj(ja)
+!-$$            END IF Trouve11
+!-$$         END DO SeekAtm1
+!-$$         !!
+!-$$         CALL verif ( 'Cas Near' )
+!-$$         !!
+!-$$         WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+!-$$         !!
+!-$$      END IF IfNear
+         !!
+!-$$      IfNei: IF (lnei) THEN
+!-$$         WRITE(nout,*) 'Route le run-off vers les autres voisins mouilles (lnei=TRUE)'
+!-$$         i2a = 0_il
+!-$$         WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) i2a = 1_il
+!-$$         SeekAtm2: DO ja = 1_il, jpan
+!-$$            IF (.NOT. laland_bord(ja) ) CYCLE SeekAtm2
+!-$$            IF (iamskp(ja) .EQ. 1_il ) CYCLE SeekAtm2
+!-$$            IF (.NOT. laland(ja) ) CYCLE SeekAtm2
+!-$$            !! Nombre de voisins
+!-$$            jai = m2ai(ja) ; jaj = m2aj(ja) ! Indices 2D
+!-$$            jai_p = mai(jai+1_il) ; jai_m = mai(jai-1_il)
+!-$$            jaj_p = maj(jaj+1_il) ; jaj_m = maj(jaj-1_il)
+!-$$            inum =  &
+!-$$               &   i2a (jai_p, jaj  ) &
+!-$$               & + i2a (jai_m, jaj  ) & 
+!-$$               & + i2a (jai  , jaj_p) &
+!-$$               & + i2a (jai  , jaj_m) &
+!-$$               & + i2a (jai_p, jaj_p) & 
+!-$$               & + i2a (jai_p, jaj_m) &  
+!-$$               & + i2a (jai_m, jaj_p) &  
+!-$$               & + i2a (jai_m, jaj_m) 
+!-$$            IF (inum == 0) WRITE(nout,*) "erreur ", ja 
+!-$$            !!
+!-$$            IF (i2a(jai_p, jaj  ) == 1_il ) CALL complet_run (m1a(jai_p, jaj  ), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_m, jaj  ) == 1_il ) CALL complet_run (m1a(jai_m, jaj  ), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai  , jaj_p) == 1_il ) CALL complet_run (m1a(jai  , jaj_p), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai  , jaj_m) == 1_il ) CALL complet_run (m1a(jai  , jaj_m), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_p, jaj_p) == 1_il ) CALL complet_run (m1a(jai_p, jaj_p), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_p, jaj_m) == 1_il ) CALL complet_run (m1a(jai_p, jaj_m), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_m, jaj_p) == 1_il ) CALL complet_run (m1a(jai_m, jaj_p), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_m, jaj_m) == 1_il ) CALL complet_run (m1a(jai_m, jaj_m), m1a(jai,jaj), inum)
+!-$$         END DO SeekAtm2
+!-$$         !!
+!-$$         CALL verif ('Cas Nei')
+!-$$         !!
+!-$$         WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+!-$$         !!
+!-$$      END IF IfNei
+         !!
+         CALL int_wei
+         !!
+         !! Controle
+         !! 
+         CALL verif (' Normalisation')
+         !!
+         CALL bilan ("Apres lcoast ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Local")
+         CALL bilan ("Apres lcoast ", c_case="terre100", c_int_atm="Integral", c_int_oce="Local")
+         CALL bilan ("Apres lcoast ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Local")
+         !!
+         WRITE (unit = nout, fmt = * ) 'Nombre de voisins : ', jma2o
+         !!
+         CALL gather_wei ('apres normalisation')
+         CALL verif ('apres gather' )
+
+         !! Atm mask interpolated to oce
+         za = REAL (1_il-iamskt, KIND = rl )
+         CALL inter_a2o (za, a2omask )
+         !! 1 on Atm interpolated to oce
+         za = REAL (1_il       , KIND = rl )
+         CALL inter_a2o (za, a2ofull )
+
+         !!
+         !! Checking weights
+         WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9  )' ) &
+            &  MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+         WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9  )' ) &
+            &  MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+         jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1)
+         joi = m2oi(jo)  ;  joj = m2oj(jo)
+         WRITE (unit = nout, fmt = '("Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+            & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+         jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1)
+         joi = m2oi(jo) ; joj = m2oj(jo)
+         WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+            & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+         !
+         jind(1:1) = INT(MAXLOC (nvo),il) ; jo = jind(1)
+         WRITE (unit = nout, fmt = *) jo, m2oi(jo), m2oj(jo), ka2o(1:nvo(jo),jo), &
+            & (m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo)), jn = 1, nvo(jo))
+         !!
+         clweight =  "WEIGHTS4" ; cladress = "ADRESSE4"
+         WRITE (unit = nout, fmt = *) cladress, " ", clweight, " ", jpa2o, jma2o
+         !!
+         !! Controle
+         !! 
+         WRITE (nout, *) 'Verif avant ecriture'
+         WRITE (nout, *) 'wa2o ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+         WRITE (nout, *) 'ka2o ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+         WRITE (nout, *) 'xasrft ', MINVAL (xasrft), MAXVAL (xasrft)
+         WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+         WRITE (nout, *) 'xosrft ', MINVAL (xosrft), MAXVAL (xosrft)
+         WRITE (nout, *) 'iomskt ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+         WRITE (nout, *) 'iomskp ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+         WRITE (nout, *) 'iamskt ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+         WRITE (nout, *) 'locot ', COUNT (locot)
+         WRITE (nout, *) 'lacot ', COUNT (lacot)
+         !!
+      ENDIF L_LCOAST
+      !!
+   END IF E_DRYRUN
+   !!
+   !!
+   WRITE (nout, *) ' '
+   WRITE (nout, *) ' '
+   WRITE (nout, *) 'Eventuels traitement specifiques'
+   WRITE (nout, *) ' '
+   WRITE (nout, *) ' '
+
+
+   !! Extension ??
+
+   !! Traitements specifiques, tres specifiques ... !!
+   IF ( TRIM(c_suffix) == "_runoffNord09" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord09'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.9
+      END DO
+   END IF
+   !
+   IF ( TRIM(c_suffix) == "_runoffNord07" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord07'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.7
+      END DO
+   END IF
+
+   IF ( TRIM(c_suffix) == "_runoffNord00" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord00'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.0
+      END DO
+   END IF
+   !!
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2or /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule / lu : ', jma2o, jma2or
+      !STOP
+   ENDIF
+   !!
+   !! Ecriture des poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+   !
+   IF ( l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.runoff.i" // TRIM(c_i) // ".r" // TRIM(c_r) // TRIM(c_suffix)
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i_4 a -> o: ', TRIM(cfname4)
+   END IF
+   !
+   IF (l_wei_i8) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM(mo_name) // ".wa2o.runoff.i" // TRIM(c_i) // ".r" // TRIM(c_r) // TRIM(c_suffix)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i_8  a -> o : ', TRIM(cfname8)
+   END IF
+   !
+   cldiag_a2o = TRIM(a2o_name) // '.runcoa.diag' 
+   clw_a2o    = TRIM(mo_name)  // '.wa2o.runcoa'
+   clw_a2o_mct= TRIM(mo_name)  // '.wa2o_mct.runcoa'
+   !
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "4", l_fulldiag, lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE., &
+      & co_omsk=TRIM(cotes_omsk), co_amsk=TRIM(cotes_amsk) )         
+   !
+   IF (lriv) THEN
+      !! Dataset 3 : cas particulier du run off des rivieres
+      !!
+      ka2o = 0 ;  wa2o = 0.0e0_rl ; nvo = 0 ; nva = 0 ; jma2o = 1
+      OPEN (unit = nriv, file = '/home/clim/ocean/CPL/DATA/riviere.dat', status = 'old', action = 'read', &
+         & form = 'formatted', position = 'rewind' )
+      jovoid = 1
+      DO jr = 1, jpr
+         READ (unit = nriv, fmt = '(1A1,2I3,1I5,1A30)' ) clriv, joi, joj, nlmd, clname
+         clname = ADJUSTL (TRIM (ADJUSTL (clname)))
+         jai = m2ai (nlmd) ; jaj = m2aj (nlmd)
+         jaj = jpaj - jaj + 1
+         ja = m1a(jai,jaj)
+         IF (joi == 99 .AND. joj == 99 ) THEN
+            !! On ramene sur la ligne j=1 de l'ocean pour faire un bilan plus tard
+            jovoid = jovoid + 1
+            WRITE (unit = nout, fmt = &
+               & '(1A, " (", 1A30, ") ", 1I3, " : ", 4I5, " : ", 2F6.1 )' ) &
+               & clriv, clname, jr, nlmd, ja, jai, jaj, xalont (ja), xalatt (ja)
+            joi = jovoid ; joj = 1
+            jo = m1o (joi, joj)
+            nva (ja) = nva (ja) + 1
+            nvo (jo) = nvo (jo) + 1
+            ka2o (nvo (jo), jo) = ja
+            wa2o (nvo (jo), jo) = 1.0e0_rl
+         ELSE
+            jo = m1o (joi, joj)
+            nva (ja) = nva (ja) + 1
+            nvo (jo) = nvo (jo) + 1
+            ka2o (nvo (jo), jo) = ja
+            IF (lint_atm .AND. lint_oce ) THEN
+               !! Atm envoie : kg.s-1, Oce reçoit : kg.s-1
+               wa2o(nvo(jo),jo) = 1.0e0_rl
+            ELSE
+               !! Atm envoie kg/m ^2/s. Oce reçoit kg/m^2/s
+               wa2o (nvo (jo), jo) = xasrft (ja) / xosrft (jo)
+            END IF
+            WRITE (unit = nout, fmt = &
+               & '(1A, " (", 1A30, ") ", 1I3, " : ", 4I5, " -> ", 2I4, 1I2, " : ", 1E12.4, "  ", 2F6.1, " -> ", 2F6.1)' ) &
+               & clriv, clname, jr, nlmd, ja, jai, jaj, joi, joj, nvo(jo), wa2o (nvo(jo),jo), xalont(ja), xalatt(ja), &
+               & clo_lon(xolont(jo),xalont(ja)), xolatt (jo)
+         END IF
+      END DO
+      CLOSE (unit = nriv)
+      jma2o = MAXVAL (nvo)
+      WRITE (unit = nout, fmt = '("Voisins atm                 : ", 2I9  )' ) &
+         &  MINVAL(nva), MAXVAL(nva)
+      WRITE (unit = nout, fmt = '("Voisins ocean               : ", 2I9  )' ) &
+         &  MINVAL(nvo), MAXVAL(nvo)
+      WRITE (unit = nout, fmt = '("Point bidons                : ", 2I9  )' ) jovoid
+      !!
+   END IF
+
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2or /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule / lu : ', jma2o, jma2or 
+      !STOP
+   ENDIF
+   !!
+   !! Ecriture des poids
+   !!
+   !! Ouverture des fichiers poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+   !
+   IF (l_wei_i4) THEN
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.rivflu"  // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i4 a -> o: ', TRIM(cfname4)
+   END IF
+   !
+   IF (l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM (mo_name) // ".wa2o.rivflu" // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i8  a -> o : ', TRIM(cfname8)
+   END IF
+
+   !
+   cldiag_a2o  = TRIM (a2o_name) // '.rivflu.diag' 
+   clw_a2o     = TRIM (mo_name)  // '.wa2o.rivflu'
+   clw_a2o_mct = "rmp_"//TRIM(camod_t)//"_to_"//TRIM(comod_t)//"_MOSAIC_rivflu"
+   !
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "3", l_fulldiag, lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE., &
+      &  co_omsk='noperio', co_amsk='full' )
+
+   !!
+   IF (l_wei_i4) CLOSE (unit = nwei8a2o)
+   IF (l_wei_i8) CLOSE (unit = nwei4a2o)
+   !!
+   WRITE (nout,*) 'Appel flioclo'
+   CALL flioclo
+   !!
+   STOP
+   !!
+CONTAINS
+   !!
+   SUBROUTINE diag_itarget (clmess, lwrite)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      LOGICAL, INTENT (in) :: lwrite
+      INTEGER, SAVE :: nappel = 0
+      CHARACTER (len=2) :: cc
+      !!
+      nappel = nappel + 1
+      !! 
+      itarget = 0_il ; wtarget = 0.0_rl
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo) 
+            IF (ja /= 0 ) THEN
+               itarget (ja) = itarget (ja) + 1_il
+               wtarget (ja) = wtarget (ja) + wa2o (jn, jo)
+            ENDIF
+         END DO
+      END DO
+      !!
+      !CALL lbc (itarget, naperio, 'T', jpai, jpaj)
+      !CALL lbc (wtarget, naperio, 'T', jpai, jpaj)
+      !!
+      IF (lwrite) THEN 
+         !$$$      WRITE(nout,*) 'itarget, etape '// clmess
+         !$$$      CALL prihin (RESHAPE(itarget,(/jpai,jpaj/)),1_il,nout)
+         WRITE (unit = cc, fmt = '(1I2.2)' ) nappel
+         CALL fliodefv (nid_it, 'itarget'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_it, 'ntarget'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_it, 'wtarget'    // cc, (/1, 2/), v_t=flio_r4)
+         CALL fliodefv (nid_it, 'non_target' // cc, (/1, 2/), v_t=flio_i4)
+
+
+         CALL flioputa (nid_it, 'itarget' // cc, 'long_name ', clmess // ' itarget' // cc)
+         CALL flioputv (nid_it, 'itarget' // cc, MIN (1, RESHAPE (itarget, (/jpai, jpaj/))) )
+
+         CALL flioputa (nid_it, 'ntarget' // cc, 'long_name ', clmess // ' ntarget' // cc)
+         CALL flioputv (nid_it, 'ntarget' // cc, RESHAPE (itarget, (/jpai, jpaj/)) )
+
+         CALL flioputa (nid_it, 'wtarget' // cc, 'long_name ', clmess // ' wtarget' // cc)
+         CALL flioputv (nid_it, 'wtarget' // cc, RESHAPE (wtarget, (/jpai, jpaj/)) )
+
+         wtarget = 0
+         WHERE (itarget .EQ. 0 .AND. (laland .OR. lacot)) wtarget = 1.0_rl
+         CALL flioputa (nid_it, 'non_target' // cc, 'long_name ', clmess // ' non_target' // cc)
+         CALL flioputv (nid_it, 'non_target' //cc, RESHAPE (NINT (wtarget), (/jpai, jpaj/)) )
+      END IF
+      !!
+   END SUBROUTINE diag_itarget
+   !!
+   SUBROUTINE int_wei
+      !!
+      IMPLICIT NONE
+      WRITE(nout,*) 'Debut normalisation'
+      !!
+      IF (.NOT. lint_atm) THEN
+         WRITE(nout,*) 'Multiplication par les surfaces atm'
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               ja = ka2o (jn, jo)
+               IF (ja > 0 ) wa2o (jn,jo) = wa2o (jn,jo) * xasrft (ja)
+            END DO
+         ENDDO
+      ENDIF
+      !!
+      IF (.NOT. lint_oce) THEN
+         WRITE (nout,*) 'Division par les surfaces oce'
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               wa2o (jn,jo) = wa2o (jn,jo) / xosrft (jo)
+            END DO
+         ENDDO
+      ENDIF
+   END SUBROUTINE int_wei
+   !!
+   SUBROUTINE complet_run (ka1, ka2, kn)
+      INTEGER (kind=il), INTENT(in) :: ka1, ka2 ! Index of atm boxes
+      INTEGER (kind=il), INTENT(in) :: kn ! Number of neighbors
+      INTEGER (kind=il) :: jt
+      !!
+      DO jo = 1, jpon
+         IF (iomskt(jo) == 1 ) CYCLE
+         IF (iomskp(jo) .EQ. 1_il ) CYCLE
+         DO jn = 1, jpa2o
+            IF (ka2o(jn,jo) == ka1 ) THEN
+               nvo(jo) = nvo(jo)+1
+               IF (nvo(jo) > jpa2o ) THEN
+                  WRITE(nout,*) 'Pas assez de voisins pour la completion '
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1)' ) ka1, m2ai(ka1), m2aj(ka1), &
+                     &   xalont(ka1), xalatt(ka1)
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1)' ) ka2, m2ai(ka2), m2aj(ka2), &
+                     &   xalont(ka2), xalatt(ka2)
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1,2I8)') jo, m2oi(jo), m2oj(jo), &
+                     &   xolont(jo), xolatt(jo), jn, nvo(jo)
+                  DO jt = 1, jpa2o
+                     WRITE(nout,fmt=*) jt, ka2o(jt,jo), xalont(ka2o(jt,jo)), xalatt(ka2o(jt,jo)), &
+                        & lacot(ka2o(jt,jo))
+                  ENDDO
+               END IF
+               ka2o (nvo (jo), jo) = ka2
+               wa2o (nvo (jo), jo) = wa2o(jn,jo) * xasrft(ka2) / xasrft(ka1) / REAL(kn,KIND=rl)
+            END IF
+         END DO
+      ENDDO
+   END SUBROUTINE complet_run
+   !!
+   SUBROUTINE gather_wei (clmess)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER (kind=il) :: jn1, jn2, jo2
+      !! Eliminate redundancy
+      DO jo = 1, jpon
+         DO jn1 = 1, jpa2o-1
+            IF (ka2o (jn1,jo) == 0 ) CYCLE
+            DO jn2 = jn1+1, jpa2o
+               IF (ka2o (jn1, jo) == ka2o (jn2, jo) ) THEN 
+                  WRITE(nout,*) 'Redondance ', jo, jn1, jn2, ka2o(jn1,jo), ka2o (jn2,jo), wa2o(jn1,jo), wa2o(jn2,jo)
+                  wa2o (jn1, jo) = wa2o (jn1, jo) + wa2o (jn2, jo)
+                  ka2o (jn2, jo) = 0
+               END IF
+            END DO
+         END DO
+      END DO
+      !!
+      !! Seek for strangeness
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo)
+            IF (ja == 0) CYCLE
+            IF (wa2o (jn, jo) == 0.0E0 ) THEN 
+               WRITE (nout, *) 'Null weight : ', jo, jn, ja, locot (jo), lacot (ja)
+            END IF
+         END DO
+      END DO
+      !!
+      !! Periodicity
+      !DO jn = 1, jpa2o
+      !   CALL lbc (wa2o (jn,:), noperio, 'T', jpoi, jpoj)
+      !   CALL lbc (ka2o (jn,:), noperio, 'T', jpoi, jpoj)
+      !END DO
+      CALL diag_itarget (' gather/perio - ' // clmess, lwrite=.TRUE.)
+      !!
+      !! Gather weights
+      DO jo = 1, jpon
+         ktemp = ka2o (:,jo) ; wtemp = wa2o (:,jo)
+         ka2o (:,jo) = 0_il  ; wa2o (:,jo) = 0.0_rl
+         kn = 1_il
+         DO jo2 = 1, jpa2o
+            IF (ktemp (jo2) /= 0_il ) THEN
+               ka2o (kn, jo) =  ktemp (jo2)
+               wa2o (kn, jo) =  wtemp (jo2)
+               kn = kn + 1_il
+            END IF
+         END DO
+      END DO
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !
+      !!
+      !! Periodicity
+      !DO jn = 1, jpa2o
+      !   CALL lbc (wa2o(jn,:), noperio, 'T', jpoi, jpoj)
+      !   CALL lbc (ka2o(jn,:), noperio, 'T', jpoi, jpoj)
+      !END DO
+      !!
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !!
+   END SUBROUTINE gather_wei
+   !!
+   SUBROUTINE verif (clmess, l_non_a)
+      !!
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER :: ja
+      LOGICAL, INTENT (in), OPTIONAL :: l_non_a
+      !!
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      CALL diag_itarget (clmess, lwrite=.TRUE.)
+      !!
+      WRITE (nout, *) ' --- Verifs -- : ', TRIM (clmess)
+      WRITE (nout, *) 'wa2o    ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+      WRITE (nout, *) 'ka2o    ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+      WRITE (nout, *) 'xasrft  ', MINVAL (xasrft), MAXVAL (xasrft)
+      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+      WRITE (nout, *) 'xosrft  ', MINVAL (xosrft), MAXVAL (xosrft)
+      WRITE (nout, *) 'iomskt  ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+      WRITE (nout, *) 'iomskp  ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+      WRITE (nout, *) 'iamskt  ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+      WRITE (nout, *) 'locot   ', COUNT (locot)
+      WRITE (nout, *) 'lacot   ', COUNT (lacot)
+      WRITE (nout, *) 'Points non attribues : ', COUNT (itarget .EQ. 0 .AND. (laland .OR. lacot))
+
+      IF (PRESENT (l_non_a)) THEN 
+         DO ja = 1, jpan
+            IF (itarget (ja) == 0 .AND. iamskp(ja) == 0 .AND. (laland (ja) .OR. lacot(ja) )) THEN
+!-$$               WRITE (UNIT=nout,FMT='("Point atm non attribues : ", 3I7, 2F7.1, 1I4)' ) ja, m2ai(ja), m2aj (ja), xalont(ja), xalatt(ja), itarget(ja)
+               WRITE (nout,*) ja, m2ai(ja), m2aj (ja), xalont(ja), xalatt(ja), itarget(ja), laland(ja), lacot(ja), laoce(ja)
+            ENDIF
+         END DO
+      END IF
+   END SUBROUTINE verif
+   !!
+   !! 
+   SUBROUTINE noroute
+      !! Determine les points atmospheres non routes
+      lanoroute = .TRUE.
+
+      DO jn = 1, jpa2o
+         DO jo = 1, jpon
+            ja = ka2o ( jo, jn)
+            IF ( ja /= 0 .AND. wa2o (jo,jn) > 0.0_rl ) THEN
+               lanoroute = .FALSE.
+            END IF
+         END DO
+      END DO
+
+   END SUBROUTINE noroute
+   !!
+   SUBROUTINE bilan (clmess, c_case, c_int_atm, c_int_oce)
+      !!
+      CHARACTER (len=*), INTENT (in) :: clmess
+      CHARACTER (len=*), INTENT (in) :: c_case ! Type de champ d'entree
+      CHARACTER (len=*), INTENT (in) :: c_int_atm ! Type d'integrale sur l'atm
+      CHARACTER (len=*), INTENT (in) :: c_int_oce ! Type d'integrale sur l'ocean
+      !!
+      WRITE (nout,*) "Bilan :" // TRIM (clmess) // ", cas :", TRIM (c_case), ", c_int_atm :", TRIM (c_int_atm),&
+         &   ", c_int_oce :", TRIM(c_int_oce), "."
+      !!
+      za = 0.0_rl
+      !!
+      SELECT CASE (TRIM (c_case))
+      CASE ('complet')
+         za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft)
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE ('terre')
+         WHERE (laland .OR. lacot)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft 
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft*(1.0-o2amask))
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE ('terre100')
+         WHERE (laland)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft 
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft)
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE ('ocean')
+         WHERE (lacot)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+         CASE default
+            WRITE (nout,*) TRIM(clmess), ' : Erreur type de bilan atm'  ; STOP
+         END SELECT
+         !!
+      CASE ('cote')
+         WHERE (lacot)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE default
+         WRITE (nout,*)'Erreur choix de cas' ; STOP
+         STOP
+      END SELECT
+      !!
+      CALL inter_a2o (za, zo)
+      !!
+      SELECT CASE (TRIM (c_int_oce))
+      CASE ('Integral')
+         zsumo = DOT_PRODUCT (zo, REAL(1-iomskp, KIND=rl))
+      CASE ('Local')
+         zsumo = DOT_PRODUCT (zo*xosrft,REAL(1-iomskp, KIND=rl))
+      CASE default
+         WRITE (nout,*) TRIM (clmess), ' : Erreur type de bilan ' ; STOP
+      END SELECT
+      !!
+      WRITE (nout, fmt='("  bilan atm: ", 1E15.6, ", bilan oce: ", 1E15.6)' ) zsuma, zsumo
+      !!
+      RETURN
+      !!
+   END SUBROUTINE bilan
+   !!
+END PROGRAM cote
+
Index: /TOOLS/MOZAIC/bld.cfg
===================================================================
--- /TOOLS/MOZAIC/bld.cfg	(revision 3326)
+++ /TOOLS/MOZAIC/bld.cfg	(revision 3326)
@@ -0,0 +1,51 @@
+# --
+# module switch netcdf netcdf/4.2
+
+cfg::type     bld                           
+cfg::version  1.0                           
+
+bld::tool::shell /bin/ksh
+
+
+# ---------- User section -----------
+
+# Maximum number polygone edges (i.e. maximum atm resolution)
+%JPOL	  180
+
+# Machine dependant configuration
+# --
+## Configuration FCM pour Cesium
+
+%ROOT    ${HOME}/CPL/MOZAIC
+%PREC	 -i4 -r8
+%F90	 ifort  %{PREC} -convert big_endian
+#%FFLAGS  -O3 -ip -no-prec-div
+#%FFLAGS	 -g -check all -check noarg_temp_created -debug all -debug-parameters all -ftrapuv -traceback
+#%FFLAGS	 -g -check arg_temp_created -check bounds -check format -check output_conversion -check pointers -check uninit -ftrapuv -traceback
+%FFLAGS	 -g -traceback
+#%FFLAGS	 -g -check all -check noarg_temp_created -debug all -debug-parameters all -ftrapuv -traceback
+
+# ---------- Do no touch -----------
+
+dir::root     %{ROOT}
+bld::target   lmdz.exe allgrid.exe mosaic.exe cotes_etal.exe isf_icb.exe icestream.exe calving.exe inv_wei.exe tstmosaic.exe
+
+search_src    1
+
+# -- Compiler, etc ...
+bld::tool::fc       %{F90}                    
+bld::tool::fflags   %{FFLAGS} -DJPOL=%{JPOL} -I${NETCDF_INC_DIR} -L${NETCDF_LIB_DIR} 
+bld::tool::ld       %{F90} %{FFLAGS} -I${NETCDF_INC_DIR} -L${NETCDF_LIB_DIR}
+bld::tool::ldflags  -lnetcdff -lnetcdf
+bld::tool::ar       ar
+
+# -- Creates libraries ????
+# bld::lib::src::POLY    poly
+# bld::lib::src::IOIPSL  ioipsl
+# bld::lib::src::MOZAIC  mozaic
+
+# -- Ignore the following dependencies
+bld::excl_dep        use::netcdf
+
+# -- Dont generate interface files 
+bld::tool::geninterface none
Index: /TOOLS/MOZAIC/chk_friver.jnl
===================================================================
--- /TOOLS/MOZAIC/chk_friver.jnl	(revision 3326)
+++ /TOOLS/MOZAIC/chk_friver.jnl	(revision 3326)
@@ -0,0 +1,28 @@
+DEFINE SYMBOL MyDir "/ccc/scratch/cont003/gencmip6/p86caub/RUN_DIR/CM5A2-BILAN_NEWOASIS01"
+
+GO use_and_define da   ($MyDir)/COLIQRUN_LMDZ_25.nc
+GO use_and_define do   ($MyDir)/O_Runoff_oceanx_25.nc
+GO use_and_define dgo  /ccc/work/cont003/dsm/p86mart/GRAF/DATA/orca2.3.nc
+GO use_and_define drmp ($MyDir)/rmp_tlmd_to_torc_MOSAIC_rivflu.nc
+
+LET runoff_srf      = O_Runoff[D=($do)]*e1t[d=($dgo)]*e2t[D=($dgo)]*maskper[D=($dgo)]
+LET runoff_srf_full = O_Runoff[D=($do)]*e1t[d=($dgo)]*e2t[D=($dgo)]
+
+LET bilo   = runoff_srf[I=@SUM,J=@SUM]/1000.0
+LET bilo_f = runoff_srf_full[I=@SUM,J=@SUM]/1000.0
+LET bila   = coliqrun[D=($da),I=@SUM,J=@SUM]
+
+LET srf_atm = RESHAPE ( src_grid_area[D=($drmp)], coliqrun[D=($da)] )
+LET srf_oce = RESHAPE ( dst_grid_area[D=($drmp)], O_Runoff[D=($do)] ) * maskper[D=($dgo)]
+
+LIST/K=1:17 bila, bilo, bilo_f, bilo/bila, (bilo-bila)/bila, bilo_f/bila, (bilo_f-bila)/bila
+
+SET WINDOW 1 ; GO page_new -i 1 2
+SET VIEW 1 ; SHADE reshape ( src_grid_imask[D=($drmp)], coliqrun[D=($da)] )
+SET VIEW 2 ; SHADE reshape ( dst_grid_imask[D=($drmp)], O_Runoff[D=($do)] )
+
+
+SET WINDOW 2 ; GO page_new -il 1 1
+SET VIEW 1
+LET xx = IF O_Runoff GT 0 THEN O_Runoff
+SHADE xx[D=($do),K=2]
Index: /TOOLS/MOZAIC/draw_rmp.jnl
===================================================================
--- /TOOLS/MOZAIC/draw_rmp.jnl	(revision 3326)
+++ /TOOLS/MOZAIC/draw_rmp.jnl	(revision 3326)
@@ -0,0 +1,9 @@
+
+
+USE rmp_tlmd_to_torc_MOSAIC_rivflu_test2.nc
+
+LET AA = I[I=1:96] * J[J=1:95]
+
+SHADE RESHAPE ( src_grid_imask, aa)
+
+
Index: /TOOLS/MOZAIC/readme.txt
===================================================================
--- /TOOLS/MOZAIC/readme.txt	(revision 3326)
+++ /TOOLS/MOZAIC/readme.txt	(revision 3326)
@@ -0,0 +1,19 @@
+Utility to generate interpolation weights for OASIS-MCT
+
+1) Read mask, grid and areas files, at OASIS format
+   Convention for mask are those of Oasis : 0 for sea, 1 for land
+
+2) Generates interpolation weights
+
+3) Write them at Oasis format
+
+4) Write some diagnostic fields in NetCDF format
+
+
+@author Olivier MARTI, june 1996
+
+Modification : Olivier MARTI, may 1997 : LMDZ case, from L. Li
+               Eric GUILYARDI, may 1999 : Gaussian Grid + ORCA
+               Olivier MARTI and Jacques BELLIER, april 2000 : use of polygon matching to compute weights
+	       Olivier MARTI, 2000-2017
+
Index: /TOOLS/MOZAIC/src/IOIPSL/calendar.f90
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/calendar.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/calendar.f90	(revision 3326)
@@ -0,0 +1,1044 @@
+MODULE calendar
+!-
+!$Id: calendar.f90 693 2009-07-29 15:49:31Z bellier $
+!-
+! 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 simplifactions 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
+!-
+      IF (month >= 13) THEN
+        yearp = year+1
+        monthp1 = monthp1-12
+      ENDIF
+      CALL ymds2ju (year,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
+      IF (monthp1 >= 13) THEN
+        yearp = year+1
+        monthp1 = monthp1 -12
+      ENDIF
+      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: /TOOLS/MOZAIC/src/IOIPSL/def.prec
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/def.prec	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/def.prec	(revision 3326)
@@ -0,0 +1,22 @@
+MODULE defprec 
+!-
+! $Id: def.prec 386 2008-09-04 08:38:48Z bellier $
+!-
+! 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_?, r_std=r_?
+!-----------------
+END MODULE defprec
Index: /TOOLS/MOZAIC/src/IOIPSL/defprec.f90
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/defprec.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/defprec.f90	(revision 3326)
@@ -0,0 +1,23 @@
+MODULE defprec 
+!-
+! $Id: def.prec 386 2008-09-04 08:38:48Z bellier $
+!-
+! 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, PUBLIC :: i_2=SELECTED_INT_KIND(4)  
+  INTEGER, PARAMETER, PUBLIC :: i_4=SELECTED_INT_KIND(9)
+  INTEGER, PARAMETER, PUBLIC :: i_8=SELECTED_INT_KIND(13)
+  INTEGER, PARAMETER, PUBLIC :: r_4=SELECTED_REAL_KIND(6,37)    !< Simple precision real
+  INTEGER, PARAMETER, PUBLIC :: r_8=SELECTED_REAL_KIND(15,307)  !< Double precision real
+  INTEGER, PARAMETER, PUBLIC :: i_std=i_4, r_std=r_8
+  !
+!-----------------
+END MODULE defprec
Index: /TOOLS/MOZAIC/src/IOIPSL/errioipsl.f90
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/errioipsl.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/errioipsl.f90	(revision 3326)
@@ -0,0 +1,214 @@
+MODULE errioipsl
+!-
+!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! 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
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   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: /TOOLS/MOZAIC/src/IOIPSL/fliocom.f90
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/fliocom.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/fliocom.f90	(revision 3326)
@@ -0,0 +1,5096 @@
+MODULE fliocom
+!-
+!$Id: fliocom.f90 886 2010-02-08 09:47:55Z bellier $
+!-
+! 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
+!-
+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   : Mode used to create the file.
+!!              Supported modes : REPLACE, REP, 32, 64, REP32, REP64.
+!!              If this argument is present with the value "REP[32/64]"
+!!              or the value "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 32 bits.
+!!
+!! 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=10
+!-
+! 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
+!-
+  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
+  IF (PRESENT(mode)) THEN
+    SELECT CASE (TRIM(mode))
+    CASE('REPLACE', 'REP', 'REP64')
+      m_c = IOR(NF90_CLOBBER, NF90_64BIT_OFFSET)
+    CASE('REP32')
+      m_c = NF90_CLOBBER
+    CASE('32')
+      m_c = NF90_NOCLOBBER
+    CASE('64')
+       m_c = IOR(NF90_NOCLOBBER, NF90_64BIT_OFFSET)
+    CASE('REPHDF')
+       m_c = IOR(NF90_CLOBBER, NF90_NETCDF4)
+    CASE ('HDF')
+       m_c = IOR(NF90_NOCLOBBER, NF90_NETCDF4)
+    CASE DEFAULT
+      m_c = IOR(NF90_NOCLOBBER, NF90_64BIT_OFFSET)
+   END SELECT
+  ELSE
+    m_c = IOR(NF90_NOCLOBBER, NF90_64BIT_OFFSET)
+  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=9)  :: 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: /TOOLS/MOZAIC/src/IOIPSL/getincom.f90
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/getincom.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/getincom.f90	(revision 3326)
@@ -0,0 +1,2008 @@
+MODULE getincom
+!-
+!$Id: getincom.f90 963 2010-03-31 15:26:11Z bellier $
+!-
+! 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=240),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: /TOOLS/MOZAIC/src/IOIPSL/stringop.f90
===================================================================
--- /TOOLS/MOZAIC/src/IOIPSL/stringop.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/IOIPSL/stringop.f90	(revision 3326)
@@ -0,0 +1,238 @@
+MODULE stringop
+!-
+!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!-
+  INTEGER,DIMENSION(30) :: &
+ & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
+ & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
+!-
+!---------------------------------------------------------------------
+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 gensig (str,sig)
+!---------------------------------------------------------------------
+!- Generate a signature from the first 30 characters of the string
+!- This signature is not unique and thus when one looks for the
+!- one needs to also verify the string.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+  INTEGER          :: sig
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  sig = 0
+  DO i=1,MIN(LEN_TRIM(str),30)
+    sig = sig + prime(i)*IACHAR(str(i:i))
+  ENDDO
+!--------------------
+END SUBROUTINE gensig
+!===
+SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
+!---------------------------------------------------------------------
+!- Find the string signature in a list of signatures
+!---------------------------------------------------------------------
+!- INPUT
+!-   nb_sig      : length of table of signatures
+!-   str_tab     : Table of strings
+!-   str         : Target string we are looking for
+!-   sig_tab     : Table of signatures
+!-   sig         : Target signature we are looking for
+!- OUTPUT
+!-   pos         : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb_sig
+  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
+  CHARACTER(LEN=*) :: str
+  INTEGER,DIMENSION(nb_sig) :: sig_tab
+  INTEGER :: sig
+!-
+  INTEGER :: pos
+  INTEGER,DIMENSION(nb_sig) :: loczeros
+!-
+  INTEGER :: il,len
+  INTEGER,DIMENSION(1) :: minpos
+!---------------------------------------------------------------------
+  pos = -1
+  il = LEN_TRIM(str)
+!-
+  IF ( nb_sig > 0 ) THEN
+    loczeros = ABS(sig_tab(1:nb_sig)-sig)
+    IF ( COUNT(loczeros < 1) == 1 ) THEN
+      minpos = MINLOC(loczeros)
+      len = LEN_TRIM(str_tab(minpos(1)))
+      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+          .AND.(len == il) ) THEN
+        pos = minpos(1)
+      ENDIF
+    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
+      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
+        minpos = MINLOC(loczeros)
+        len = LEN_TRIM(str_tab(minpos(1)))
+        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
+            .AND.(len == il) ) THEN
+          pos = minpos(1)
+        ELSE
+          loczeros(minpos(1)) = 99999
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-----------------------
+ END SUBROUTINE find_sig
+!===
+!------------------
+END MODULE stringop
Index: /TOOLS/MOZAIC/src/MOZAIC/allgrid.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/allgrid.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/allgrid.f90	(revision 3326)
@@ -0,0 +1,235 @@
+! -*- Mode: f90 -*-
+PROGRAM allgrid
+   !!
+   !! Lit les fichiers de masques, grilles et surfaces des deux models,
+   !! et reecrit dans un seul fichier
+   !! Un simple 'cat' des deux fichiers dans un seul ne marche pas (pourquoi ?)
+   !!
+   !! Fichiers IEEE : 11,12,13,21,22,23,31,32,33
+   !!
+   USE declare
+   USE dimensions
+   USE modeles
+   USE mod_locio
+   USE mod_prih
+   USE mod_inipar
+   IMPLICIT NONE
+   !!
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xoclon, xoclat
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xaclon, xaclat
+   !!
+   INTEGER (kind=il) :: nocegrid = 11, nocesrf = 12, nocemsk = 13
+   INTEGER (kind=il) :: natmgrid = 21, natmsrf = 22, natmmsk = 23
+   INTEGER (kind=il) :: ncplgrid = 31, ncplsrf = 32, ncplmsk = 33
+   CHARACTER (len = 80) :: cfname
+   CHARACTER (len=20) :: cores
+   CHARACTER (len=1) :: c_i, c_r
+   REAL    (kind=rl), ALLOCATABLE, DIMENSION (:, :) :: z2a, z2o
+   INTEGER (kind=il), ALLOCATABLE, DIMENSION (:, :) :: i2a, i2o
+   INTEGER (kind=il) :: il_grid, il_mask, il_area, il_o2a, il_a2o, nco2a
+   !!
+   INTEGER (kind=il) :: ierr = 0
+   !!
+   CALL inipar
+   CALL alloc_modeles
+   !!
+   ALLOCATE (xoclon (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'xoclon', lreset = .TRUE., crout = 'allgrid')
+   ALLOCATE (xoclat (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'xoclat')
+   ALLOCATE (xaclon (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'xaclon')
+   ALLOCATE (xaclat (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'xaclat')
+   !!
+   WRITE (nout, fmt = '("Dimension atmopshere : ", 3I8)') jpai, jpaj, jpan
+   WRITE (nout, fmt = '("Dimension ocean      : ", 3I8)') jpoi, jpoj, jpon
+   !!
+   SELECT CASE (TRIM (cotyp))
+   CASE ('orca4')
+      cores   = 'orca4'
+   CASE ('orca2')
+      cores   = 'orca2'
+   CASE ('orca2.0')
+      cores   = 'orca2.0'
+   CASE ('orca2.1')
+      cores   = 'orca2.1'
+   CASE ('orca05')
+      cores   = 'orca05'
+   END SELECT
+   !!
+   IF (locerev) THEN
+      comod_t = 't'//TRIM (comod)
+      comod_u = 'u'//TRIM (comod)
+      comod_v = 'v'//TRIM (comod)
+      comod_f = 'f'//TRIM (comod)
+   ELSE
+      comod_t = TRIM (comod) // 't' 
+      comod_u = TRIM (comod) // 'u' 
+      comod_v = TRIM (comod) // 'v' 
+      comod_f = TRIM (comod) // 'f' 
+   ENDIF
+   camod_a = 'a' // TRIM (camod)
+   camod_t = 't' // TRIM (camod)
+   camod_u = 'u' // TRIM (camod)
+   camod_v = 'v' // TRIM (camod)
+   !!
+   !!IF (TRIM(c_period) /= 'none') cores = TRIM (cores) // TRIM (c_period)
+   !! 
+   WRITE (unit = c_r, fmt = '(1I1)') rk_in
+   cfname = TRIM (cores) // ".grids.r" // TRIM(c_r)
+   WRITE(nout,*) 'Reading ', TRIM(cfname)
+   OPEN (unit = nocegrid, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+   CALL locread (TRIM(comod_t) // '.lon', xolont, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 001
+   CALL locread (TRIM(comod_t) // '.lat', xolatt, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 002
+   CALL locread (TRIM(comod_u) // '.lon', xolonu, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 003
+   CALL locread (TRIM(comod_u) // '.lat', xolatu, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 004
+   CALL locread (TRIM(comod_v) // '.lon', xolonv, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 005
+   CALL locread (TRIM(comod_v) // '.lat', xolatv, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 006
+   CALL locread (TRIM(comod_f) // '.lon', xolonf, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 007
+   CALL locread (TRIM(comod_f) // '.lat', xolatf, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 008
+   CALL locread (TRIM(comod_t) // '.clo', xoclon, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 009
+   CALL locread (TRIM(comod_t) // '.cla', xoclat, jpon, nocegrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 010
+   !
+   SELECT CASE (TRIM(catyp))
+   CASE ('lmdz')
+      WRITE (unit = cfname, fmt = '("lmd.grids.r", 1I1)') rk_in
+      WRITE(nout,*) 'Reading ', TRIM(cfname)
+      OPEN (unit = natmgrid, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+      CALL locread (TRIM(camod_t)//'.lon', xalont, jpan , natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 011
+      CALL locread (TRIM(camod_t)//'.lat', xalatt, jpan , natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 012
+      CALL locread (TRIM(camod_u)//'.lon', xalonu, jpan , natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 013
+      CALL locread (TRIM(camod_u)//'.lat', xalatu, jpan , natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 014
+      CALL locread (TRIM(camod_v)//'.lon', xalonv, jpanv, natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 015
+      CALL locread (TRIM(camod_v)//'.lat', xalatv, jpanv, natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 016
+      CALL locread (TRIM(camod_t)//'.clo', xaclon, jpan , natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 017
+      CALL locread (TRIM(camod_t)//'.cla', xaclat, jpan , natmgrid, ierr, 6_il) ; IF (ierr /= 0_il) STOP 017
+   CASE ('gaussian')
+      cfname = "grids_orca_t106"
+      WRITE(nout,*) 'Reading ', TRIM(cfname)
+      OPEN (unit = natmgrid, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+      CALL locread (TRIM(camod_a)//'.lon', xalont, jpan , natmgrid, ierr, 6_il) ;   IF (ierr /= 0_il) STOP 011
+      CALL locread (TRIM(camod_a)//'.lat', xalatt, jpan , natmgrid, ierr, 6_il) ;   IF (ierr /= 0_il) STOP 012
+      xalonu = xalont
+      xalatu = xalatt
+      xalonv = xalont
+      xalatv = xalatt
+   END SELECT
+   !
+   WRITE (unit = cfname, fmt = '("grids.r", 1I1)') rk_in
+   WRITE(nout,*) 'Writing ', TRIM(cfname)
+   OPEN (unit = ncplgrid, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'write')
+   WRITE (unit = ncplgrid) TRIM(comod_t) // '.lon' ; WRITE (unit = ncplgrid) REAL (xolont, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_t) // '.lat' ; WRITE (unit = ncplgrid) REAL (xolatt, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_u) // '.lon' ; WRITE (unit = ncplgrid) REAL (xolonu, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_u) // '.lat' ; WRITE (unit = ncplgrid) REAL (xolatu, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_v) // '.lon' ; WRITE (unit = ncplgrid) REAL (xolonv, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_v) // '.lat' ; WRITE (unit = ncplgrid) REAL (xolatv, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_f) // '.lon' ; WRITE (unit = ncplgrid) REAL (xolonf, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_f) // '.lat' ; WRITE (unit = ncplgrid) REAL (xolatf, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_t) // '.clo' ; WRITE (unit = ncplgrid) REAL (xoclon, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(comod_t) // '.cla' ; WRITE (unit = ncplgrid) REAL (xoclat, kind = rk_in)
+
+   WRITE (unit = ncplgrid) TRIM(camod_t) //'.lon' ; WRITE (unit = ncplgrid) REAL (xalont, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_t) //'.lat' ; WRITE (unit = ncplgrid) REAL (xalatt, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_u) //'.lon' ; WRITE (unit = ncplgrid) REAL (xalonu, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_u) //'.lat' ; WRITE (unit = ncplgrid) REAL (xalatu, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_v) //'.lon' ; WRITE (unit = ncplgrid) REAL (xalonv, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_v) //'.lat' ; WRITE (unit = ncplgrid) REAL (xalatv, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_t) //'.clo' ; WRITE (unit = ncplgrid) REAL (xaclon, kind = rk_in)
+   WRITE (unit = ncplgrid) TRIM(camod_t) //'.cla' ; WRITE (unit = ncplgrid) REAL (xaclat, kind = rk_in)
+   !!
+   WRITE (unit = c_i, fmt = '(1I1)') ik_in
+   cfname = TRIM(cores) // ".masks.i" // TRIM(c_i)
+   WRITE(nout,*) 'Reading ', TRIM(cfname)
+   OPEN (unit = nocemsk, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+   CALL locrint (TRIM(comod_t) // '.msk', iomskt, jpon, nocemsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 021
+   CALL locrint (TRIM(comod_u) // '.msk', iomsku, jpon, nocemsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 022
+   CALL locrint (TRIM(comod_v) // '.msk', iomskv, jpon, nocemsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 023
+   CALL locrint (TRIM(comod_f) // '.msk', iomskf, jpon, nocemsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 023
+   !
+   SELECT CASE (TRIM(catyp))
+   CASE ('lmdz')
+      WRITE (unit = cfname, fmt = '("lmd.masks.i", 1I1)') ik_in
+      WRITE(nout,*) 'Reading ', TRIM(cfname)
+      OPEN (unit = natmmsk, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+      CALL locrint (TRIM(camod_t) // '.msk', iamskt, jpan , natmmsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 031
+      CALL locrint (TRIM(camod_u) // '.msk', iamsku, jpan , natmmsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 032
+      CALL locrint (TRIM(camod_v) // '.msk', iamskv, jpanv, natmmsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 033
+   CASE ('gaussian')
+      cfname = "masks_orca_t106"
+      WRITE(nout,*) 'Reading ', TRIM(cfname)
+      OPEN (unit = natmmsk, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+      CALL locrint (TRIM(camod_a) // '.msk', iamskt, jpan , natmmsk, ierr, 6_il) ; IF (ierr /= 0_il) STOP 031
+      iamsku = iamskt
+      iamskv = iamskt
+   END SELECT
+   !!
+   WRITE (unit = nout, fmt = *) 'Masque atm'
+   CALL prihin (RESHAPE ( iamskt, (/ jpai, jpaj /)), 1_il, nout)
+   WRITE (unit = nout, fmt = *) 'Masque ocean'
+   CALL prihin (RESHAPE ( iomskt, (/ jpoi, jpoj /)), 1_il, nout)
+   !!
+   WRITE (unit = cfname, fmt = '("masks.i", 1I1)') i_4
+   WRITE(nout,*) 'Writing ', TRIM(cfname)
+   OPEN (unit = ncplmsk, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'write')
+   WRITE(nout,*) 'Writing ', TRIM(comod_t) // '.msk'
+   WRITE (unit = ncplmsk) TRIM(comod_t) // '.msk' ; WRITE (unit = ncplmsk) INT (iomskt, kind = i_4)
+   WRITE (unit = ncplmsk) TRIM(comod_u) // '.msk' ; WRITE (unit = ncplmsk) INT (iomsku, kind = i_4)
+   WRITE (unit = ncplmsk) TRIM(comod_v) // '.msk' ; WRITE (unit = ncplmsk) INT (iomskv, kind = i_4)
+   WRITE (unit = ncplmsk) TRIM(comod_f) // '.msk' ; WRITE (unit = ncplmsk) INT (iomskf, kind = i_4)
+
+   WRITE (unit = ncplmsk) TRIM(camod_t) // '.msk' ; WRITE (unit = ncplmsk) INT (iamskt, kind = i_4)
+   WRITE (unit = ncplmsk) TRIM(camod_u) // '.msk' ; WRITE (unit = ncplmsk) INT (iamsku, kind = i_4)
+   WRITE (unit = ncplmsk) TRIM(camod_v) // '.msk' ; WRITE (unit = ncplmsk) INT (iamskv, kind = i_4)
+   CLOSE  (unit = ncplmsk)
+   !
+   WRITE (unit = cfname, fmt = '("masks.i", 1I1)') i_8
+   WRITE(nout,*) 'Writing ', TRIM(cfname)
+   OPEN (unit = ncplmsk, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'write')
+   WRITE(nout,*) 'Writing ', TRIM(comod_t) // '.msk'
+   WRITE (unit = ncplmsk) TRIM(comod_t) // '.msk' ; WRITE (unit = ncplmsk) INT (iomskt, kind = i_8)
+   WRITE (unit = ncplmsk) TRIM(comod_u) // '.msk' ; WRITE (unit = ncplmsk) INT (iomsku, kind = i_8)
+   WRITE (unit = ncplmsk) TRIM(comod_v) // '.msk' ; WRITE (unit = ncplmsk) INT (iomskv, kind = i_8)
+   WRITE (unit = ncplmsk) TRIM(comod_f) // '.msk' ; WRITE (unit = ncplmsk) INT (iomskf, kind = i_8)
+
+   WRITE(nout,*) 'Writing ', TRIM(camod_t)//'.msk' 
+   WRITE (unit = ncplmsk) TRIM(camod_t) // '.msk' ; WRITE (unit = ncplmsk) INT (iamskt, kind = i_8)
+   WRITE (unit = ncplmsk) TRIM(camod_t) // '.msk' ; WRITE (unit = ncplmsk) INT (iamsku, kind = i_8)
+   WRITE (unit = ncplmsk) TRIM(camod_t) // '.msk' ; WRITE (unit = ncplmsk) INT (iamskv, kind = i_8)
+   CLOSE  (unit = ncplmsk)
+   !!
+   WRITE (unit = c_r, fmt = '(1I1)') rk_in
+   cfname = TRIM(cores) // ".areas.r" // TRIM(c_r)
+   WRITE(nout,*) 'writing ', TRIM(cfname)
+   OPEN (unit = nocesrf, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+   CALL locread (TRIM(comod_t) // '.srf', xosrft, jpon, nocesrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 041
+   CALL locread (TRIM(comod_u) // '.srf', xosrfu, jpon, nocesrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 042
+   CALL locread (TRIM(comod_v) // '.srf', xosrfv, jpon, nocesrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 043
+   !
+   SELECT CASE (TRIM(catyp))
+   CASE ('lmdz')
+      WRITE (unit = cfname, fmt = '("lmd.areas.r", 1I1)') rk_in
+      WRITE(nout,*) 'Reading ', TRIM(cfname)
+      OPEN (unit = natmsrf, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+      CALL locread (TRIM(camod_t) // '.srf', xasrft, jpan , natmsrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 051
+      CALL locread (TRIM(camod_u) // '.srf', xasrfu, jpan , natmsrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 052
+      CALL locread (TRIM(camod_v) // '.srf', xasrfv, jpanv, natmsrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 053
+   CASE (' gaussian')
+      cfname = "areas_orca_t106"
+      WRITE(nout,*) 'reading ', TRIM(cfname)
+      OPEN (unit = natmsrf, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read')
+      CALL locread (TRIM(camod_a) // '.srf', xasrft, jpan , natmsrf, ierr, 6_il) ; IF (ierr /= 0_il) STOP 051
+      xasrfu = xasrft
+      xasrfv = xasrft
+   END SELECT
+   !
+   WRITE (unit = cfname, fmt = '("areas.r", 1I1)') rk_in
+   WRITE(nout,*) 'Writing ', TRIM(cfname)
+   OPEN (unit = ncplsrf, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'write')
+   WRITE (unit=ncplsrf) TRIM(comod_t) // '.srf' ; WRITE (unit = ncplsrf) REAL (xosrft, kind = rk_in)
+   WRITE (unit=ncplsrf) TRIM(comod_u) // '.srf' ; WRITE (unit = ncplsrf) REAL (xosrfu, kind = rk_in)
+   WRITE (unit=ncplsrf) TRIM(comod_v) // '.srf' ; WRITE (unit = ncplsrf) REAL (xosrfv, kind = rk_in)
+
+   WRITE (unit = ncplsrf) TRIM(camod_t) // '.srf' ; WRITE (unit = ncplsrf) REAL (xasrft, kind = rk_in)
+   WRITE (unit = ncplsrf) TRIM(camod_u) // '.srf' ; WRITE (unit = ncplsrf) REAL (xasrfu, kind = rk_in)
+   WRITE (unit = ncplsrf) TRIM(camod_v) // '.srf' ; WRITE (unit = ncplsrf) REAL (xasrfv, kind = rk_in)
+   !!
+   STOP
+END PROGRAM allgrid
Index: /TOOLS/MOZAIC/src/MOZAIC/bord.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/bord.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/bord.f90	(revision 3326)
@@ -0,0 +1,483 @@
+! -*- Mode: f90 -*-
+MODULE bords
+   USE modeles
+   USE formula
+   PRIVATE
+   PUBLIC bord_a, bord_o, bord_oa
+CONTAINS
+   !!
+   SUBROUTINE bord_a 
+      IMPLICIT NONE
+      INTEGER (kind=il) :: jai, jaj
+      REAL (kind=rl) :: xs_n, xs_s
+      
+      WRITE (nout,*) 'Debut bord_a'
+      
+      SELECT CASE (TRIM(catyp))
+      CASE ('lmd5')
+         CALL bord_lmd5 ( xa_ed, ya_ed )
+      CASE ('lmdz')
+         CALL bord_lmdz ( xa_ed, ya_ed )
+      CASE ('gaussian')
+         CALL bord_gaussian ( xa_ed, ya_ed )
+      END SELECT
+
+!-$$      xa_ed ( :, jpae) = xalont ( : )
+!-$$      ya_ed ( :, jpae) = xalatt ( : )
+      !
+      !! Periodicity masks
+      iamskp = 0_il
+      
+      IF ( la_pole ) THEN 
+         DO jai = 2, jpai
+            iamskp (m1a (jai, 1_il)) = 1_il
+            iamskp (m1a (jai, jpaj)) = 1_il
+         END DO
+         xs_n = 0.0_rl ; xs_s = 0.0_rl
+         DO jai = 1_il, jpai
+            xs_n = xs_n + xasrft ( m1a (jai, jpaj))
+            xs_s = xs_n + xasrft ( m1a (jai,  1  ))
+         END DO
+         DO jai = 2_il, jpai
+            xasrft ( m1a (jai, jpaj)) = 0.0_rl
+            xasrft ( m1a (jai,  1  )) = 0.0_rl
+         END DO
+         xasrft ( m1a (1_il, jpaj)) = xs_s
+         xasrft ( m1a (1_il, 1_il)) = xs_n  
+      END IF
+      
+      RETURN
+      
+   END SUBROUTINE bord_a
+   
+   SUBROUTINE bord_o
+      IMPLICIT NONE
+      INTEGER (kind=il) :: joi, joj
+
+      WRITE (nout,*) 'Debut bord_o'      
+            
+      SELECT CASE ( TRIM(comod) )
+      CASE ('opa')
+         CALL bord_opa ( xo_ed, yo_ed )
+      CASE ('orc')
+         CALL bord_opa ( xo_ed, yo_ed )
+      CASE ('grn')
+         CALL bord_grisli ( xo_ed, yo_ed )
+      CASE ('grs')
+         CALL bord_grisli ( xo_ed, yo_ed )
+      END SELECT
+
+      xo_ed ( :, jpoe) = xolont ( : )
+      yo_ed ( :, jpoe) = xolatt ( : )
+
+      iomskp = 0_il
+
+      ! Periodical edge set to zero to suppress double points for ocean
+      SELECT CASE ( noperio)
+      CASE ( 1, 4, 5 ,6 )
+         DO joj = 1, jpoj 
+            iomskp (m1o (1_il, joj)) = 1_il
+            iomskp (m1o (jpoi, joj)) = 1_il
+         END DO
+      END SELECT
+
+      IF (noperio == -4_il ) THEN 
+         DO joi = jpoi/2+2, jpoi
+            iomskp (m1o (joi, jpoj) ) = 1_il
+         END DO
+      ENDIF
+
+      ! Supress duplicate points due to the North fold
+      SELECT CASE (noperio)
+      CASE ( 3, 4)
+         DO joi = 1, jpoi
+            iomskp (m1o (joi, jpoj  ) ) = 1_il
+         END DO
+         DO joi = jpoi/2+2, jpoi
+            iomskp (m1o (joi, jpoj-1) ) = 1_il
+         END DO
+      CASE ( 6)
+         DO joi = 1, jpoi
+            iomskp (m1o (joi, jpoj  ) ) = 1_il
+         END DO
+      CASE ( -1)
+         DO joi = 2, jpoi
+            iomskp (m1o (joi, 1_il)) = 1_il
+            iomskp (m1o (joi, jpoj)) = 1_il
+         END DO
+      CASE (-4) 
+         DO joi = jpoi/2+2, jpoi
+            iomskp (m1o (joi, jpoj) ) = 1_il
+         END DO
+      END SELECT
+
+      RETURN
+
+   END SUBROUTINE bord_o
+      
+   SUBROUTINE bord_oa
+      IMPLICIT NONE
+      INTEGER :: jn, jo
+      REAL (kind=rl) :: xmin, xmax
+
+      WRITE (nout,*) 'Debut bord_oa'
+            
+      !!
+      !! All ocean longitudes are set within the limits of the atmospheric grid
+      !!
+      xinf = MINVAL (xa_ed) ; xsup = MAXVAL (xa_ed)
+      !!
+      DO jn = 1, 3
+         WHERE ( xo_ed (:,jpoe) <  xinf ) xo_ed (:,jpoe) = xo_ed (:,jpoe) + 360.0_rl
+         WHERE ( xo_ed (:,jpoe) >  xsup ) xo_ed (:,jpoe) = xo_ed (:,jpoe) - 360.0_rl
+      END DO
+      !!
+      !! In longitude, takes the closest lon, referring to the center of the box
+      DO jn = 1, jpoe-1
+         DO jo = 1, jpon
+            xo_ed (jo, jn) = clo_lon ( xo_ed (jo, jn), xo_ed (jo, jpoe) )
+         END DO
+      END DO
+
+      xa_inf = MINVAL (xa_ed) ; xa_sup = MAXVAL (xa_ed)
+      ya_inf = MINVAL (ya_ed) ; ya_sup = MAXVAL (ya_ed)
+      xo_inf = MINVAL (xo_ed) ; xo_sup = MAXVAL (xo_ed)
+      yo_inf = MINVAL (yo_ed) ; yo_sup = MAXVAL (yo_ed)
+
+      IF ( yo_sup > 85.0_rl ) yo_sup = 90.0_rl
+
+      WRITE (nout,*) 'Extrema atm : ', xa_inf, xa_sup, ya_inf, ya_sup
+      WRITE (nout,*) 'Extrema oce : ', xo_inf, xo_sup, yo_inf, yo_sup
+
+      WRITE (nout,*) 'Bord_oa'
+      WRITE (nout,*) 'xae : ', MINVAL (xae), MAXVAL (xae)
+      WRITE (nout,*) 'xaw : ', MINVAL (xaw), MAXVAL (xaw)
+      WRITE (nout,*) 'yan : ', MINVAL (yan), MAXVAL (yan)
+      WRITE (nout,*) 'yas : ', MINVAL (yas), MAXVAL (yas)
+
+   END SUBROUTINE bord_oa
+   
+   SUBROUTINE bord_lmd5 ( xx_ed, yy_ed )
+      !! 
+      !! Find limits of each atm grid box
+      !!
+      !! For LMD 5
+      !!
+      !! C grid in Arakawa classification
+      !! One uses u and v points to find grid box limits
+      !!  La limite Est   (xae) est le point u ( i-1, j) 
+      !!  La limite Ouest (xaw) est le point u ( i  , j) 
+      !!  La limite Nord  (xan) est le point v ( i, j+1)
+      !!  La limite Sud   (xas) est le point v ( i, j  )
+      !!  Don't forget periodicity for u point 
+      !!
+      !!
+      IMPLICIT NONE
+      !!
+      REAL (kind=rl), DIMENSION (:,:), INTENT (out) :: xx_ed, yy_ed
+      INTEGER (kind=il) :: ja, jai, jaj, jn
+      WRITE (nout,*) 'Debut bord_lmd5'
+      !!
+      DO ja = 1, jpan
+         jai = MOD ( ja - 1, jpai) + 1 ; jaj = ( ja - 1) / jpai + 1   ! 2D index of atm grid box
+         !!
+         SELECT CASE ( jai) 
+         CASE (   1_il)  ; xaw ( ja) = xalonu ( jpai  )  ; xae ( ja) = xalonu ( ja)
+         CASE default ; xaw ( ja) = xalonu ( ja - 1)  ; xae ( ja) = xalonu ( ja)
+         END SELECT
+         IF ( xae ( ja) < xalont ( ja) ) xae ( ja) = xae ( ja) + 360.0
+         IF ( xaw ( ja) > xalont ( ja) ) xaw ( ja) = xaw ( ja) - 360.0
+         yas ( ja) = xalatv ( ja) ; yan ( ja) = xalatv ( ja + jpai)
+      END DO
+      
+      xx_ed (:,1) = xaw    (:)
+      xx_ed (:,2) = xalont (:)
+      xx_ed (:,3) = xae    (:)
+      xx_ed (:,4) = xae    (:)
+      xx_ed (:,5) = xae    (:)
+      xx_ed (:,6) = xalont (:)
+      xx_ed (:,7) = xaw    (:)
+      xx_ed (:,8) = xaw    (:)
+      xx_ed (:,9) = xalont (:)
+      !
+      yy_ed (:,1) = yan    (:)
+      yy_ed (:,2) = yan    (:)
+      yy_ed (:,3) = yan    (:)
+      yy_ed (:,4) = xalatt (:)
+      yy_ed (:,5) = yas    (:)
+      yy_ed (:,6) = yas    (:)
+      yy_ed (:,7) = yas    (:)
+      yy_ed (:,8) = xalatt (:)
+      yy_ed (:,9) = xalatt (:)
+  
+      !
+   END SUBROUTINE bord_lmd5
+   !!
+   SUBROUTINE bord_lmdz ( xx_ed, yy_ed )
+      !!
+      !! Calculer les bords d'une maille pour LMDZ pour une grille reguliere
+      !!
+      !! Tous les points sont au point physique. On se sert d'eux pour
+      !! determiner les limites des mailles.
+      !!
+      IMPLICIT NONE
+      !!
+      REAL (kind=rl), DIMENSION (:,:), INTENT (out) :: xx_ed, yy_ed
+      INTEGER (kind=il) :: ja, jai, jaj, jn
+      !
+      xx_ed (:,1) = xaw    (:)
+      xx_ed (:,2) = xalont (:)
+      xx_ed (:,3) = xae    (:)
+      xx_ed (:,4) = xae    (:)
+      xx_ed (:,5) = xae    (:)
+      xx_ed (:,6) = xalont (:)
+      xx_ed (:,7) = xaw    (:)
+      xx_ed (:,8) = xaw    (:)
+      xx_ed (:,9) = xalont (:)
+      !
+      yy_ed (:,1) = yan    (:)
+      yy_ed (:,2) = yan    (:)
+      yy_ed (:,3) = yan    (:)
+      yy_ed (:,4) = xalatt (:)
+      yy_ed (:,5) = yas    (:)
+      yy_ed (:,6) = yas    (:)
+      yy_ed (:,7) = yas    (:)
+      yy_ed (:,8) = xalatt (:)
+      yy_ed (:,9) = xalatt (:)
+
+      !! In longitude, takes the closest lon, refering to the center
+      DO jai = 1, jpan
+         DO jn = 1, 8 
+            xx_ed(jai,jn) = clo_lon ( xx_ed(jai,jn), xx_ed(jai,9) )
+         END DO
+      END DO
+      
+      ! remet les points 'au milieu' pour avoir une projection plus precise
+!-$$      xx_ed(:,9) = 0.5 * ( MINVAL(xx_ed(:,1:8),DIM=2) + MAXVAL(xx_ed(:,1:8),DIM=2) )
+!-$$      yy_ed(:,9) = 0.5 * ( MINVAL(yy_ed(:,1:8),DIM=2) + MAXVAL(yy_ed(:,1:8),DIM=2) )
+!-$$
+       xx_ed(:,9) = 0.5 * ( xae (:) + xaw (:) )
+       yy_ed(:,9) = 0.5 * ( yas (:) + yan (:) )
+
+       WRITE (nout,*) 'Bord LMDZ'
+       WRITE (nout,*) 'xae : ', MINVAL (xae), MAXVAL (xae)
+       WRITE (nout,*) 'xaw : ', MINVAL (xaw), MAXVAL (xaw)
+       WRITE (nout,*) 'yan : ', MINVAL (yan), MAXVAL (yan)
+       WRITE (nout,*) 'yas : ', MINVAL (yas), MAXVAL (yas)
+
+      !
+      RETURN
+   END SUBROUTINE bord_lmdz
+   !
+   SUBROUTINE bord_gaussian ( xx_ed, yy_ed )
+      !!
+      !! Calcule les bords d'une maille Gaussian
+      !! Grille Gaussienne (repris tel que de lmdz)
+      !!
+      IMPLICIT NONE
+      !!
+      REAL (kind=rl), DIMENSION (:,:) :: xx_ed, yy_ed
+      INTEGER (kind=il) :: ja, jai, jaj
+      REAL (kind=rl) :: xdel, ydel, yinf, ysup
+      !!
+      WRITE (nout,*) 'Debut bord_gaussian'
+      !
+      xinf =  1.0e+20 ; xsup = -1.0e+20
+      !
+      DO ja = 1, jpan
+         jai = m2ai ( ja) ; jaj = m2aj ( ja)
+         IF ( jai == 1 ) THEN
+            xdel = ( xalont ( ja + 1) - xalont ( ja)) * 0.5
+            xaw ( ja) = xalont ( ja) - xdel ; xae ( ja) = xalont ( ja) + xdel
+         ELSE IF ( jai == jpai ) THEN
+            xdel = ( xalont ( ja) - xalont ( ja-1))/2.0
+            xaw ( ja) = xalont ( ja) - xdel ; xae ( ja) = xalont ( ja) + xdel
+         ELSE
+            xaw ( ja) = ( xalont ( ja) + xalont ( ja - 1)) * 0.5
+            xae ( ja) = ( xalont ( ja) + xalont ( ja + 1)) * 0.5
+         ENDIF
+         IF ( xae ( ja) < xaw ( ja) ) xae ( ja) = xae ( ja) + 360.0
+         xinf = min ( xinf, xaw ( ja), xae ( ja))
+         xsup = max ( xsup, xaw ( ja), xae ( ja))
+      ENDDO
+      !!
+      PRINT*, "XINF=", xinf
+      PRINT*, "XSUP=", xsup
+      !!
+      !   xaw (     1          : jpai) = xinf 
+      !   xae (     1          : jpai) = xsup
+      !   xaw ( jpan - jpai + 1: jpan) = xinf
+      !   xae ( jpan - jpai + 1: jpan) = xsup
+      !
+      yinf = 1.0e+20
+      ysup = -1.0e+20
+      DO ja = 1, jpan
+         jai = m2ai ( ja) ; jaj = m2aj ( ja)
+         IF ( jaj == 1) THEN
+            ydel = ( xalatt ( ja + jpai) - xalatt ( ja)) / 2.0
+            yas ( ja) = xalatt ( ja) - ydel
+            yan ( ja) = xalatt ( ja) + ydel
+         ELSE IF ( jaj == jpaj) THEN
+            ydel = ( xalatt ( ja) - xalatt ( ja - jpai))/2.0
+            yas ( ja) = xalatt ( ja) - ydel
+            yan ( ja) = xalatt ( ja) + ydel
+         ELSE
+            yas ( ja) = ( xalatt ( ja) + xalatt ( ja - jpai)) / 2.0
+            yan ( ja) = ( xalatt ( ja) + xalatt ( ja + jpai)) / 2.0
+         ENDIF
+         !     IF ( yas ( ja) < yinf) yinf = yas ( ja)
+
+         yinf = min ( yinf, yas ( ja), yan ( ja))
+         ysup = max ( ysup, yas ( ja), yan ( ja))
+      ENDDO
+      PRINT*, "YINF=", xinf
+      PRINT*, "YSUP=", xsup
+      !!
+      RETURN
+   END SUBROUTINE bord_gaussian
+   !!
+   SUBROUTINE bord_grisli ( xx_ed, yy_ed ) 
+      !!
+      IMPLICIT NONE
+      REAL (kind=rl), DIMENSION (:,:), INTENT (inout) :: xx_ed, yy_ed
+      INTEGER (kind=il) :: jn, jo, ji, jj, jpe
+      !!
+      WRITE (nout,*) 'Debut bord_grisli'
+      !! Corner are directly read in lecdata
+      jpe = SIZE ( xx_ed, DIM=2 )
+      !!
+   END SUBROUTINE bord_grisli
+   !!
+   SUBROUTINE bord_opa ( xx_ed, yy_ed )
+      !!
+      IMPLICIT NONE
+      REAL (kind=rl), DIMENSION (:,:), INTENT (out) :: xx_ed, yy_ed
+      INTEGER (kind=il) :: jn, jo, ji, jj
+      REAL :: ylim_south
+      !!
+      WRITE (nout,*) 'Debut bord_opa'
+      !
+      ylim_south = MIN ( MINVAL(xolatt), MINVAL(xolatu), MINVAL(xolatv), MINVAL(xolatf))
+      !!
+      !! Set edges (upper-left, upper-middle, upper-right, middle-right,lower-right,middle-lower,lower-left,middle-left) of each grid box
+      !! Highly depending of the model
+      DO jj = 2, jpoj
+         DO ji = 2, jpoi
+            xx_ed (m1o(ji,jj),1) = xolonf ( m1o(ji-1,jj  ))
+            xx_ed (m1o(ji,jj),2) = xolonv ( m1o(ji  ,jj  ))
+            xx_ed (m1o(ji,jj),3) = xolonf ( m1o(ji  ,jj  ))
+            xx_ed (m1o(ji,jj),4) = xolonu ( m1o(ji  ,jj  ))
+            xx_ed (m1o(ji,jj),5) = xolonf ( m1o(ji  ,jj-1))
+            xx_ed (m1o(ji,jj),6) = xolonv ( m1o(ji  ,jj-1))
+            xx_ed (m1o(ji,jj),7) = xolonf ( m1o(ji-1,jj-1))
+            xx_ed (m1o(ji,jj),8) = xolonu ( m1o(ji-1,jj  ))
+            xx_ed (m1o(ji,jj),9) = xolont ( m1o(ji  ,jj  ))
+            !!
+            yy_ed (m1o(ji,jj),1) = xolatf ( m1o(ji-1,jj  ))
+            yy_ed (m1o(ji,jj),2) = xolatv ( m1o(ji  ,jj  ))
+            yy_ed (m1o(ji,jj),3) = xolatf ( m1o(ji  ,jj  ))
+            yy_ed (m1o(ji,jj),4) = xolatu ( m1o(ji  ,jj  ))
+            yy_ed (m1o(ji,jj),5) = xolatf ( m1o(ji  ,jj-1))
+            yy_ed (m1o(ji,jj),6) = xolatv ( m1o(ji  ,jj-1))
+            yy_ed (m1o(ji,jj),7) = xolatf ( m1o(ji-1,jj-1))
+            yy_ed (m1o(ji,jj),8) = xolatu ( m1o(ji-1,jj  ))
+            yy_ed (m1o(ji,jj),9) = xolatt ( m1o(ji  ,jj  ))
+         END DO
+      END DO
+      !! Boundary South
+      DO jj = 1_il, 1_il
+         DO ji = 2, jpoi
+            xx_ed (m1o(ji, 1_il),1) = xolonf ( m1o(ji-1, 1_il  ))
+            xx_ed (m1o(ji, 1_il),2) = xolonv ( m1o(ji  , 1_il  ))
+            xx_ed (m1o(ji, 1_il),3) = xolonf ( m1o(ji  , 1_il  ))
+            xx_ed (m1o(ji, 1_il),4) = xolonu ( m1o(ji  , 1_il  ))
+            xx_ed (m1o(ji, 1_il),5) = xolonf ( m1o(ji  , 1_il  ))
+            xx_ed (m1o(ji, 1_il),6) = xolonv ( m1o(ji  , 1_il  ))
+            xx_ed (m1o(ji, 1_il),7) = xolonf ( m1o(ji-1, 1_il  ))
+            xx_ed (m1o(ji, 1_il),8) = xolonu ( m1o(ji-1, 1_il  ))
+            xx_ed (m1o(ji, 1_il),9) = xolont ( m1o(ji  , 1_il  ))
+            !!
+            yy_ed (m1o(ji, 1_il),1) = xolatf ( m1o(ji-1, 1_il  ))
+            yy_ed (m1o(ji, 1_il),2) = xolatv ( m1o(ji  , 1_il  ))
+            yy_ed (m1o(ji, 1_il),3) = xolatf ( m1o(ji  , 1_il  ))
+            yy_ed (m1o(ji, 1_il),4) = xolatu ( m1o(ji  , 1_il  ))
+            yy_ed (m1o(ji, 1_il),5) = ylim_south
+            yy_ed (m1o(ji, 1_il),6) = ylim_south
+            yy_ed (m1o(ji, 1_il),7) = ylim_south
+            yy_ed (m1o(ji, 1_il),8) = xolatu ( m1o(ji-1, 1_il  ))
+            yy_ed (m1o(ji, 1_il),9) = xolatt ( m1o(ji  , 1_il  ))
+         END DO
+      END DO
+      !!
+      !! Boundaries (west) 
+
+      DO jj = 2, jpoj
+         DO ji = 1, 1
+            xx_ed (m1o( 1_il,jj),1) = xolonf ( m1o(jpoi- 1,jj  ))
+            xx_ed (m1o( 1_il,jj),2) = xolonv ( m1o( 1_il  ,jj  ))
+            xx_ed (m1o( 1_il,jj),3) = xolonf ( m1o( 1_il  ,jj  ))
+            xx_ed (m1o( 1_il,jj),4) = xolonu ( m1o( 1_il  ,jj  ))
+            xx_ed (m1o( 1_il,jj),5) = xolonf ( m1o( 1_il  ,jj-1))
+            xx_ed (m1o( 1_il,jj),6) = xolonv ( m1o( 1_il  ,jj-1))
+            xx_ed (m1o( 1_il,jj),7) = xolonf ( m1o(jpoi- 1,jj-1))
+            xx_ed (m1o( 1_il,jj),8) = xolonu ( m1o(jpoi- 1,jj  ))
+            xx_ed (m1o( 1_il,jj),9) = xolont ( m1o( 1_il  ,jj  ))
+            !!
+            yy_ed (m1o( 1_il,jj),1) = xolatf ( m1o(jpoi- 1,jj  ))
+            yy_ed (m1o( 1_il,jj),2) = xolatv ( m1o( 1_il  ,jj  ))
+            yy_ed (m1o( 1_il,jj),3) = xolatf ( m1o( 1_il  ,jj  ))
+            yy_ed (m1o( 1_il,jj),4) = xolatu ( m1o( 1_il  ,jj  ))
+            yy_ed (m1o( 1_il,jj),5) = xolatf ( m1o( 1_il  ,jj-1))
+            yy_ed (m1o( 1_il,jj),6) = xolatv ( m1o( 1_il  ,jj-1))
+            yy_ed (m1o( 1_il,jj),7) = xolatf ( m1o(jpoi- 1,jj-1))
+            yy_ed (m1o( 1_il,jj),8) = xolatu ( m1o(jpoi- 1,jj  ))
+            yy_ed (m1o( 1_il,jj),9) = xolatt ( m1o( 1_il  ,jj  ))
+         END DO
+      END DO
+      DO jj = 1, 1
+         DO ji = 1, 1
+            xx_ed (m1o( 1_il, 1_il),1) = xolonf ( m1o(jpoi- 1, 1_il ))
+            xx_ed (m1o( 1_il, 1_il),2) = xolonv ( m1o( 1_il  , 1_il ))
+            xx_ed (m1o( 1_il, 1_il),3) = xolonf ( m1o( 1_il  , 1_il ))
+            xx_ed (m1o( 1_il, 1_il),4) = xolonu ( m1o( 1_il  , 1_il ))
+            xx_ed (m1o( 1_il, 1_il),5) = xolonf ( m1o( 1_il  , 1_il ))
+            xx_ed (m1o( 1_il, 1_il),6) = xolonv ( m1o( 1_il  , 1_il ))
+            xx_ed (m1o( 1_il, 1_il),7) = xolonf ( m1o(jpoi- 1, 1_il ))
+            xx_ed (m1o( 1_il, 1_il),8) = xolonu ( m1o(jpoi- 1, 1_il ))
+            xx_ed (m1o( 1_il, 1_il),9) = xolont ( m1o( 1_il  , 1_il ))
+            !!
+            yy_ed (m1o( 1_il, 1_il),1) = xolatf ( m1o(jpoi- 1, 1_il ))
+            yy_ed (m1o( 1_il, 1_il),2) = xolatv ( m1o( 1_il  , 1_il ))
+            yy_ed (m1o( 1_il, 1_il),3) = xolatf ( m1o( 1_il  , 1_il ))
+            yy_ed (m1o( 1_il, 1_il),4) = xolatu ( m1o( 1_il  , 1_il ))
+            yy_ed (m1o( 1_il, 1_il),5) = xolatf ( m1o( 1_il  , 1_il ))
+            yy_ed (m1o( 1_il, 1_il),6) = xolatv ( m1o( 1_il  , 1_il ))
+            yy_ed (m1o( 1_il, 1_il),7) = xolatf ( m1o(jpoi- 1, 1_il ))
+            yy_ed (m1o( 1_il, 1_il),8) = xolatu ( m1o(jpoi- 1, 1_il ))
+            yy_ed (m1o( 1_il, 1_il),9) = xolatt ( m1o( 1_il  , 1_il ))
+         END DO
+      END DO
+      !!
+      !! All ocean longitudes are set within the limits of the atmospheric grid
+      !!
+      xinf = MINVAL (xx_ed) ; xsup = MAXVAL (xx_ed)
+      !!
+      DO jn = 1, 3
+         WHERE ( xx_ed (:,9) <  xinf ) xx_ed (:,9) = xx_ed (:,9) + 360.0_rl
+         WHERE ( xx_ed (:,9) >  xsup ) xx_ed (:,9) = xx_ed (:,9) - 360.0_rl
+      END DO
+      !!
+      !! In longitude, takes the closest lon, refering to the center of the box
+      DO jo = 1, jpon
+         DO jn = 1, 8 
+            xx_ed ( jo, jn) = clo_lon ( xx_ed ( jo, jn), xx_ed ( jo, 9) )
+         END DO
+      END DO
+      !!
+      xow (:) = MINVAL (xx_ed(:,:), DIM=2)
+      xoe (:) = MAXVAL (xx_ed(:,:), DIM=2)
+      yos (:) = MINVAL (yy_ed(:,:), DIM=2)
+      yon (:) = MAXVAL (yy_ed(:,:), DIM=2)
+      !!
+   END SUBROUTINE bord_opa
+END MODULE bords
Index: /TOOLS/MOZAIC/src/MOZAIC/build_poly.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/build_poly.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/build_poly.f90	(revision 3326)
@@ -0,0 +1,34 @@
+! -*- Mode: f90 -*-
+MODULE mod_build
+CONTAINS
+   !!
+   SUBROUTINE build_poly (x, y, pol )
+!!!
+!!! Build a polygone from arrays of coordinates
+!!!
+      USE declare
+      USE u_polyg
+      !!
+      IMPLICIT NONE
+      !!
+      REAL (kind=rp), DIMENSION (:), INTENT (in) :: x, y
+      TYPE (polyg), INTENT ( out) :: pol
+      INTEGER (kind=il) :: n, i
+      !!
+      !! Check size
+      n = SIZE (x)
+      IF ( SIZE (y) /= n ) THEN
+         pol%n = 0
+         RETURN
+      ENDIF
+      !!
+      pol%n = n
+      DO i = 1, n
+         pol%pt(i) = (/ x(i), y(i) /)
+      END DO
+      !!
+      RETURN
+      !!
+   END SUBROUTINE build_poly
+END MODULE mod_build
+ 
Index: /TOOLS/MOZAIC/src/MOZAIC/calving.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/calving.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/calving.f90	(revision 3326)
@@ -0,0 +1,363 @@
+! -*- Mode: f90 -*-
+PROGRAM calving
+   USE declare
+   USE modeles
+   USE mod_lecdata
+   USE formula
+   USE math
+   USE mod_rectifie
+   USE mod_lbc
+   USE bords
+   USE mod_prih
+   USE mod_wri_wei
+   USE fliocom
+   USE errioipsl
+   USE getincom
+   USE mod_inipar
+   USE mod_inter
+!!!
+   IMPLICIT NONE
+!!!
+!!!   A partir d'un fichier de poids, complete avec les poids pour l'eau qui
+!!!   vient des calottes
+   !!
+
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: ynorth, ysouth
+   REAL (kind=rl), PARAMETER :: zm_frac = 0.0_rl ! Fraction criterium
+   !!
+   INTEGER (kind=il) :: ja, jo, jn, joi, joj, jai, jaj, jr, kn ! indices de boucle
+   INTEGER (kind=il), DIMENSION (:, :), ALLOCATABLE :: imask ! Masque
+   REAL (kind=rl)    :: zosrf, zasrf ! Surface totale
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zasrf_lat ! Surface atmosphere par bande de latitude
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: wtemp
+   REAL(kind=rl), DIMENSION (:, :), ALLOCATABLE  :: z2o
+   CHARACTER (len=80) :: cfname4, cfname8
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE  :: i2a
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE  :: i2o
+   CHARACTER (len=50) :: cldiag_a2o, clw_a2o, clw_a2o_mct
+   INTEGER (kind=il) :: ierr
+   LOGICAL :: l_no_pac
+   !!
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   INTEGER (kind=i_4) :: il_ncid
+   CHARACTER (len=40) :: clatl
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: tmask_atl, tmask_noclose, tmask_nomed, tmask_med
+   !!
+   CHARACTER (len = 25) :: mo_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   !!
+   
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   CALL inipar
+   CALL alloc_modeles
+   !!
+   CALL ipsldbg (l_ipsldbg)
+   !!
+   !! Initialisation
+   !! 
+   ALLOCATE (imask (jpon, jp_calv), STAT=ierr)  ; CALL chk_allo (ierr, 'imask', lreset=.TRUE., crout='icestream')
+   ALLOCATE (zasrf_lat (jpaj)     , STAT=ierr)  ; CALL chk_allo (ierr, 'zasrf_lat')
+   ALLOCATE (wtemp (jpa2o)        , STAT=ierr)  ; CALL chk_allo (ierr, 'wtemp')
+   ALLOCATE (ktemp (jpa2o)        , STAT=ierr)  ; CALL chk_allo (ierr, 'ktemp')
+   ALLOCATE (z2o (jpoi, jpoj)     , STAT=ierr)  ; CALL chk_allo (ierr, 'z2o')
+   ALLOCATE (i2a (jpai, jpaj)     , STAT=ierr)  ; CALL chk_allo (ierr, 'i2a')
+   ALLOCATE (i2o (jpoi, jpoj)     , STAT=ierr)  ; CALL chk_allo (ierr, 'i2o')
+   ALLOCATE (tmask_atl     (jpon) , STAT=ierr)  ; CALL chk_allo (ierr, 'tmask_atl')
+   ALLOCATE (tmask_noclose (jpon) , STAT=ierr)  ; CALL chk_allo (ierr, 'tmask_noclose')
+   ALLOCATE (tmask_nomed   (jpon) , STAT=ierr)  ; CALL chk_allo (ierr, 'tmasl_nomed')
+   ALLOCATE (tmask_med     (jpon) , STAT=ierr)  ; CALL chk_allo (ierr, 'tmask_med')
+   !!
+   ALLOCATE (ynorth (1:jp_calv)   , STAT=ierr)  ; CALL chk_allo (ierr, 'ynorth')
+   ALLOCATE (ysouth (1:jp_calv)   , STAT=ierr)  ; CALL chk_allo (ierr, 'ynorth')
+   !!
+   ysouth (1:jp_calv) = ylimits (1:jp_calv)
+   ynorth (1:jp_calv) = ylimits (2:jp_calv+1)
+   !!
+   !! Initialisation
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13 ; nchk = 14 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 21 ; nwei8o2a = 22 ; nwei4a2o = 23 ; nwei8a2o = 24
+   !
+   nout = 0
+   IF (nout /= 6 .AND. nout /= 0 ) THEN
+      OPEN (unit = nout, file = 'icestream.out', action = 'write', status = 'unknown', position = 'rewind' )
+   END IF
+   !
+   jma2o = 0_il ; jmo2a = 0_il ; nvo = 0_il
+   !!
+   !! Diagnostics files
+   !!
+!$$$  OPEN (unit = nout, file = 'icestreams.out', position = 'REWIND', action = 'write', status = 'replace' )
+!$$$  !!
+   !! Read coordinates of all models, and weights
+   !!
+   CALL lecdata (lecweights = .FALSE., leco2amask = .TRUE. )
+   !!
+   wa2o = zero ; ka2o = 0_il
+   !
+!    CALL ipsldbg (.TRUE. )
+   !
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+   CALL lbc (xalont, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalonu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalonv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !!
+   CALL rectifie
+   !!
+   !! Calcul de la surface par bande de latitude atmosphere
+   DO jaj = 1_il, jpaj
+      zasrf_lat(jaj) = 0.0_rl
+      DO jai = 1_il, jpai
+         ja = m1a(1_il, jaj)
+         zasrf_lat(jaj) = zasrf_lat(jaj) + xasrft(ja)
+      END DO
+   ENDDO
+   DO jaj = 1, jpaj
+      WRITE(UNIT=nout,FMT='(1F7.1,1PE15.3)' ) xalatt ( m1a (1_il, jaj)), zasrf_lat (jaj)
+   END DO
+   WRITE(nout,*) SUM (zasrf_lat)
+   !!
+   CALL bord_a
+   !!
+   mo_name  = "mozaic"
+   a2o_name = "a2o"
+   !!
+   CALL bord_o
+   CALL bord_oa
+   !!
+   WRITE (nout,*) 'o2amask ', COUNT (o2amask > 0 ), COUNT (o2amask <=  0 )
+   i2a = 0_il
+   WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) i2a = 1_il
+   CALL prihin (i2a , 1_il, nout )
+   !!
+   !! Lecture masques de bassin
+   IF ( TRIM (cotyp) == 'orca2' .OR. TRIM (cotyp) == 'orca2.0' .OR. TRIM (cotyp) == 'orca2.1' .OR. TRIM (cotyp) == 'orca4' ) THEN 
+      clatl = TRIM (cotyp)
+!-$$      IF (c_period /= 'none' ) clatl = TRIM (clatl) // TRIM (c_period)
+      clatl = TRIM (clatl) // '.nc'
+      CALL flioopfd (TRIM (clatl), il_ncid )
+      CALL fliogetv (il_ncid, 'mask_atl'    , z2o )
+      tmask_atl = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_noclose', z2o )
+      tmask_noclose = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_nomed'  , z2o )
+      tmask_nomed = RESHAPE (z2o, (/ jpon /) )
+      CALL flioclo (il_ncid)
+   ELSE
+      tmask_atl     = REAL (1-iomskt, rl)
+      tmask_noclose = REAL (1-iomskt, rl)
+      tmask_nomed   = REAL (1-iomskt, rl)
+   END IF
+   !
+   WRITE (unit=nout, fmt=*) 'iomskt'
+   CALL prihin (RESHAPE(iomskt             ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_atl'
+   CALL prihin (RESHAPE(NINT(tmask_atl)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_med'
+   CALL prihin (RESHAPE(NINT(tmask_med)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_noclose'
+   CALL prihin (RESHAPE(NINT(tmask_noclose),(/jpoi,jpoj/)), 1_il, nout)
+   !
+   Bassin: DO jr = 1_il, jp_calv !! Boucle sur les zones
+      !!
+      !! Creation du masque
+      !!
+      imask (:,jr) = 1_il
+      !!
+      tmask_med = 0.0_r_4
+      WHERE (tmask_atl > 0.5_r_4 .AND. tmask_nomed < 0.5_r_4 ) tmask_med = 1.0_r_4
+
+      ! Limite nord incluse, limite sud exclue
+      WHERE (tmask_noclose > 0.5_r_4 .AND. (xolatt > ysouth (jr) .AND. xolatt <= ynorth (jr)) ) imask(:,jr) = iomskt
+
+      WHERE (tmask_med (:) > 0.5_rl ) imask (:,jr) = 1_il
+      IF (l_no_pac) WHERE (tmask_atl (:) < 0.5_rl .AND. xolatt > ysouth (jp_calv) )  imask (:,jr) = 1_il
+      !!
+      WRITE(nout,*) 'Bassin ', jr
+      i2o =  RESHAPE ( imask(:,jr), (/jpoi, jpoj/))
+      CALL prihin (i2o, 1_il, nout)
+      !!
+      !! Calcul de la surface totale de la zone ocean
+      zosrf = DOT_PRODUCT (xosrft, REAL(1-imask(:,jr),KIND=rl)*REAL(1-iomskp,KIND=rl) )
+      WRITE(nout,*) 'Surface de la zone ', jr, zosrf
+      !!
+      !! Calcul de la surface totale de la zone atmosphere
+      zasrf = 0.0_rl
+      DO ja = 1, jpan
+         IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) zasrf = zasrf + xasrft(ja)
+      END DO
+      !!
+      !! Calcul des poids
+      WRITE(nout,*) 'Calcul des poids'
+      DO jo = 1, jpon
+         IF ( imask(jo,jr) == 0_il ) THEN 
+            DO ja = 1_il, jpan
+               IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) THEN 
+                  nvo (jo) = nvo (jo) + 1
+                  IF (nvo(jo) .GT. jpa2o ) THEN
+                     WRITE (nout,*) 'Nombre de voisins insuffisants ', jpa2o
+                     WRITE (nout,*) jr, jo, ja, xalatt(ja), ysouth(jr), ynorth(jr)
+                     STOP
+                  END IF
+                  ka2o (nvo(jo), jo) = ja
+                  wa2o (nvo(jo), jo) = xasrft(ja) / zosrf
+               ENDIF
+            ENDDO
+         END IF
+      END DO
+      !!
+      jma2o = MAXVAL (nvo)
+      !!
+   END DO Bassin
+   !!
+   WRITE(nout, *) 'jma2o : ', jma2o
+   !!
+   ! Tests bassins
+   WRITE(nout,*) 'Somme des bassins '
+   i2o =  RESHAPE (SUM(1-imask,DIM=2)*(1-iomskp), (/jpoi, jpoj/) )
+   CALL prihin (i2o, 1_il, nout)
+   !
+   WRITE(nout,*) 'Somme des bassins '
+   i2o =  RESHAPE ((1-iomskt)-SUM(1-imask,DIM=2)*(1-iomskp), (/jpoi, jpoj/) )
+   CALL prihin (i2o, 1_il, nout)
+   !
+   WRITE(nout,*) 'Somme des bassins '
+   i2o =  RESHAPE (SUM(imask,DIM=2), (/jpoi, jpoj/))
+   CALL prihin (i2o, 1_il, nout)
+   !!
+   !! Normalisation
+   !!
+!$$$      WRITE (nout, *) 'wa2o ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+!$$$      WRITE (nout, *) 'ka2o ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+!$$$      WRITE (nout, *) 'xasrft ', MINVAL (xasrft), MAXVAL (xasrft)
+!$$$      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+!$$$      WRITE (nout, *) 'xosrft ', MINVAL (xosrft), MAXVAL (xosrft)
+!$$$      WRITE (nout, *) 'iomskt ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+!$$$      WRITE (nout, *) 'iomskp ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+!$$$      WRITE (nout, *) 'iamskt ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+!$$$      WRITE (nout, *) 'locot ', COUNT (locot)
+   !!
+   CALL gather_wei
+   !!
+   !! Checking weights
+   WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9  )' ) MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+   WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9  )' ) MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+   jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+      & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+   jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+      & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+   !
+   jind(1:1) = INT(MAXLOC (nvo),il) ; jo = jind(1)
+   WRITE (unit = nout, fmt = *) jo, m2oi(jo), m2oj(jo), ka2o(1:nvo(jo),jo), &
+      & (m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo)), jn = 1, nvo(jo))
+   !!
+   ! Calcul du masque
+   CALL inter_a2o (REAL (1-iamskt, KIND = rl), a2omask)
+   !!
+!-$$   za = 1.0_rl
+!-$$   CALL inter_a2o (za, zo)
+!-$$   !
+!-$$   zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+   
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2oi /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule : ', jma2o
+      WRITE (nout, *) ' jma2o lu      : ', jma2oi
+      STOP
+   ENDIF
+   !!
+   !! Ecriture des poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+
+   IF (l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.fullcalvin.i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace', action = 'write')
+      WRITE (nout, *) 'Poids i_4 a -> o : ', TRIM(cfname4)
+   END IF
+
+   IF (l_wei_i8) THEN
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM(mo_name) // ".wa2o.fullcalvin.i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace', action = 'write')
+      WRITE (nout, *) 'Poids i_8 a -> o : ', TRIM(cfname8)
+   END IF
+
+   cldiag_a2o  = TRIM(a2o_name) // '.fullcalvin.diag'
+   clw_a2o     = 'mozaic.wa2o.fullcalvin'
+   clw_a2o_mct = "rmp_"//TRIM(camod_t)//"_to_"//TRIM(comod_t)//"_MOSAIC_fullcalvin"
+
+   WRITE (nout, *) 'Calling wri_weights_a2o ', cldiag_a2o, clw_a2o, "5"
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "5" )
+
+   IF (l_wei_i4) CLOSE (unit = nwei8a2o)
+   IF (l_wei_i8) CLOSE (unit = nwei4a2o)
+   !
+   STOP
+   !!
+CONTAINS
+   !!
+   SUBROUTINE gather_wei
+      !! Periodicity
+      DO jn = 1, jpa2o
+         CALL lbc (wa2o(jn,:) , noperio, 'T', jpoi, jpoj)
+         CALL lbc (ka2o(jn,:) , noperio, 'T', jpoi, jpoj)
+      END DO
+      !!
+      !! Gather weights
+      DO jo = 1, jpon
+         ktemp = ka2o(:,jo) ; wtemp = wa2o(:,jo)
+         ka2o(:,jo) = 0_il  ; wa2o(:,jo) = 0.0_rl
+         kn = 1_il
+         DO jn = 1, jma2o
+            IF (ktemp(jn) /= 0_il ) THEN
+               ka2o(kn,jo) =  ktemp(jn)
+               wa2o(kn,jo) =  wtemp(jn)
+               kn = kn + 1_il
+            END IF
+         END DO
+      END DO
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !!
+   END SUBROUTINE gather_wei
+   !!
+END PROGRAM calving
+
Index: /TOOLS/MOZAIC/src/MOZAIC/chrono.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/chrono.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/chrono.f90	(revision 3326)
@@ -0,0 +1,46 @@
+! -*- Mode: f90 -*-
+! ------------------------------------------------------------------
+SUBROUTINE chrono ( kout)
+   USE declare
+   !!
+   IMPLICIT NONE
+   INTEGER (kind=r4), INTENT ( in) :: kout
+   CHARACTER (len = 10) :: cldate, cltime, clzone
+   INTEGER (kind=r4), DIMENSION ( 12) :: values
+   REAL    (kind=r4), SAVE :: time, time0
+   INTEGER (kind=r4), SAVE :: hour, hour0, min, min0, sec, sec0, mill, mill0
+   REAL    (kind=r4) :: delai
+   !!
+   CALL DATE_AND_TIME ( cldate, cltime, clzone, values)
+   !!
+   READ ( unit = cltime, fmt = *) time
+   IF ( time0 .LE. 0.0_r4 ) time0 = time
+   !!
+   CALL time2time ( time , hour , min , sec , mill )
+   CALL time2time ( time0, hour0, min0, sec0, mill0)
+   !!
+   delai = (mill-mill0) + 1000*((sec-sec0) + (min-min0)*60)
+   !!
+   WRITE ( kout, FMT = '( "Heure : ", 1I2, "h", 1I2.2, "m", 1I2.2, "s", 1I3.3, " --> diff = ", 1F12.5, " secondes" )') &
+      &  hour, min, sec, mill, delai / 1000.0
+   time0 = time
+   !!
+CONTAINS
+   SUBROUTINE time2time ( time, hour, min, sec, mill )
+      IMPLICIT NONE
+      !!
+      REAL    (kind=r4), INTENT ( in) :: time
+      INTEGER (kind=r4), INTENT ( out) :: hour, min, sec, mill
+      REAL    (kind=r4) :: z
+      !!
+      hour = INT ( time/10000.0 )
+      z    = time - REAL ( hour,KIND=r4) * 10000
+      min  = INT ( z/100.0_r4)
+      z    = z - REAL (min,KIND=r4)*100
+      sec = INT ( z )
+      z = ( z - REAL(sec,KIND=r4)) * 1000.0
+      mill = INT ( z )
+      !!
+      RETURN
+   END SUBROUTINE time2time
+END SUBROUTINE chrono
Index: /TOOLS/MOZAIC/src/MOZAIC/correct.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/correct.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/correct.f90	(revision 3326)
@@ -0,0 +1,104 @@
+!-$$! -*- Mode: f90 -*-
+!-$$!>
+!-$$!!
+!-$$!! Last phase for weights 
+!-$$!! Atmospheric Model : LMD5, LMDz or spectral model with Gaussian grid
+!-$$!!
+!-$$SUBROUTINE correct_o2a
+!-$$   
+!-$$   !! Checking weights
+!-$$   WRITE ( unit = nout, fmt = '( "Neighbors o2a     : ", 3I9  )' ) MINVAL (nva, nva /=0), MAXVAL (nva), jmo2a
+!-$$   WRITE ( unit = nout, fmt = '( "Index o2a         : ", 2I9  )' ) MINVAL (ko2a, ko2a /= 0), MAXVAL (ko2a)
+!-$$   jind = MINLOC(wo2a, wo2a /= 0.0_rl) ; ja = jind(2) ; jn = jind(1); jai = m2ai(ja) ; jaj = m2aj(ja)
+!-$$   WRITE ( unit = nout, fmt = '( "Weights o2a mini : ", 4I6, 1E13.4, 3I6)' ) &
+!-$$      & ja, jn, jai, jaj, wo2a(jn,ja), ko2a(jn,ja), m2oi(ko2a(jn,ja)), m2oj(ko2a(jn,ja))
+!-$$   jind = MAXLOC(wo2a, wo2a /= 0.0_rl) ; ja = jind(2) ; jn = jind(1); jai = m2ai(ja) ; jaj = m2aj(ja)
+!-$$   WRITE ( unit = nout, fmt = '( "Weights o2a maxi : ", 4I6, 1E13.4, 3I6)' ) &
+!-$$      & ja, jn, jai, jaj, wo2a(jn,ja), ko2a(jn,ja), m2oi(ko2a(jn,ja)), m2oj(ko2a(jn,ja))
+!-$$   !! Ocean mask interpolated to atm
+!-$$   CALL inter_o2a ( REAL ( 1-iomskt, KIND = rl ), o2amask )
+!-$$!$$$  WRITE (nout,*) 'Ocean mask interpolated to atm before normalisation'
+!-$$!$$$  CALL prihre( RESHAPE(o2amask,(/jpai,jpaj/)),jpai,jpaj,1_il,jpai,1_il,1_il,jpaj,1_il,1.0_rl,INT(nout,kind=i4))
+!-$$   
+!-$$   WRITE ( nout, *) 'Low sea fraction before normalization'
+!-$$   DO jn = 1, 12
+!-$$      zzz = 10.0_rl**(-jn)
+!-$$      WRITE ( nout, *) 'Classe : ', jn, COUNT ( o2amask .LE. zzz .AND. o2amask .GT. zzz/10.0_rl )
+!-$$   END DO
+!-$$   WRITE ( nout, *) 'High sea fraction'
+!-$$   DO jn = 1, 12
+!-$$      zzz = 10.0_rl**(-jn)
+!-$$      WRITE ( nout, *) 'Classe : ', jn, COUNT ( 1.0_rl-o2amask .LE. zzz .AND. 1.0_rl-o2amask .GT. zzz/10.0_rl )
+!-$$   END DO
+!-$$   !! Remove small fractions
+!-$$   WHERE ( o2amask <        epsfrac ) o2amask = 0.0_rl
+!-$$   WHERE ( o2amask > 1.0_rl-epsfrac ) o2amask = 1.0_rl
+!-$$
+!-$$   DO jo = 1, jpon
+!-$$      DO jn = 1, jma2o
+!-$$         ja=ka2o(jn,jo)
+!-$$         IF ( ja > 0 ) THEN
+!-$$            IF ( o2amask(ja) < epsfrac ) THEN
+!-$$               wa2o(jn,jo) = 0.0_rl
+!-$$               ka2o(jn,jo) = 0_il
+!-$$               wo2a(:,ja)  = 0.0_rl
+!-$$               ko2a(:,ja)  = 0_il
+!-$$            END IF
+!-$$         END IF
+!-$$      END DO
+!-$$   END DO
+!-$$   
+!-$$   !! Gather weights
+!-$$   ALLOCATE(ktemp(jpo2a), STAT=ierr) ; CALL chk_allo (ierr, 'ktemp(jpo2a)', lreset=.TRUE., crout='correct') 
+!-$$   ALLOCATE(wtemp(jpo2a), STAT=ierr) ; CALL chk_allo (ierr, 'wtemp(jpo2a)')
+!-$$   DO ja = 1, jpan
+!-$$    ktemp = ko2a(:,ja) ; wtemp = wo2a(:,ja)
+!-$$    ko2a(:,ja) = 0_il  ; wo2a(:,ja) = 0.0_rl
+!-$$    kn = 1
+!-$$    DO jn = 1, jmo2a
+!-$$      IF ( ktemp(jn) /= 0_il ) THEN
+!-$$          ko2a(kn,ja) =  ktemp(jn)
+!-$$          wo2a(kn,ja) =  wtemp(jn)
+!-$$          kn = kn + 1
+!-$$      END IF
+!-$$    END DO
+!-$$  END DO
+!-$$  nva = COUNT ( ko2a /= 0, DIM = 1)
+!-$$  jmo2a = MAXVAL ( COUNT ( ko2a /= 0, DIM = 1))
+!-$$  WRITE ( unit = nout, fmt = * ) 'Nombre de voisins : ', jmo2a
+!-$$  DEALLOCATE(ktemp) ; DEALLOCATE(wtemp)
+!-$$
+!-$$  WRITE ( nout, *) 'Calling normalization '
+!-$$  CALL norma ( knorma2o = 0, knormo2a = normo2a )
+!-$$ 
+!-$$  !! Periodicity atm
+!-$$  DO jn = 1, jpo2a
+!-$$    CALL lbc ( wo2a(jn,:) , naperio, 'T', jpai, jpaj)
+!-$$    CALL lbc ( ko2a(jn,:) , naperio, 'T', jpai, jpaj)
+!-$$  END DO
+!-$$  CALL lbc ( o2amask, naperio, 'T', jpai, jpaj)
+!-$$   
+!-$$
+!-$$  WRITE ( unit = nout, fmt = '("Oce->Atm : ", 1I9, " non-null adresses, ", 1I9, " non-null weights ")') & 
+!-$$     & COUNT ( wo2a > 0.0_rl), COUNT ( ko2a > 0)
+!-$$
+!-$$
+!-$$  RETURN
+!-$$END SUBROUTINE correct_o2a
+!-$$
+SUBROUTINE correct_a2o
+   
+ !! Checking weights
+  WRITE ( unit = nout, fmt = '( "Neighbors a2o     : ", 3I9  )' ) MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+  WRITE ( unit = nout, fmt = '( "Index a2o         : ", 2I9  )' ) MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+  jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+  WRITE ( unit = nout, fmt = '( "Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+     &jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+  jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+  WRITE ( unit = nout, fmt = '( "Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+     & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+
+  !! Atm mask interpolated to oce
+  CALL inter_a2o ( REAL ( 1-iamskt, KIND = rl ), a2omask )
+!$$$  WRITE (nout,*) 'Atm mask interpolated to oce before normalization'
+!$$$  CALL prihre( RESHAPE(a2omask,(/jpoi,jpoj/)),jpoi,jpoj,1_il,jpoi,1_il,1_il,jpoj,1_il,1.0_rl,INT(nout,kind=i4))
Index: /TOOLS/MOZAIC/src/MOZAIC/correction.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/correction.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/correction.f90	(revision 3326)
@@ -0,0 +1,2307 @@
+!-*- Mode: f90 -*-
+MODULE mod_correct
+   USE modeles
+CONTAINS
+   SUBROUTINE correct (i1, j1, i2, j2)
+      !!
+      !! Attribue les poids/adresses de points trouves a des points isoles voisins
+      !! (mers interieures, etc...)
+      !!
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=i4), INTENT ( in) :: i1, j1, i2, j2
+      INTEGER (kind=il) :: idx1, idx2
+      !!
+      idx1 = INT ( i1 + (j1-1)*jpai, KIND = il)
+      idx2 = INT ( i2 + (j2-1)*jpai, KIND = il)
+      wo2a (:,idx1) = wo2a (:,idx2)
+      ko2a (:,idx1) = ko2a (:,idx2)
+      nva  (idx1)   = nva (idx2)
+      !!
+   END SUBROUTINE correct
+
+   SUBROUTINE correct2 (i1, j1, i2, j2, i3, j3)
+      !!
+      !! Attribue les poids/adresses de points trouves a des points isoles voisins
+      !! (mers interieures, etc...)
+      !!
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=i4), INTENT ( in) :: i1, j1, i2, j2, i3, j3
+      INTEGER (kind=il) :: idx, idx3, ji, jj
+      !!
+      idx3 = INT ( i3 + (j3-1)*jpai, KIND = il)
+      DO jj = j1, j2
+         DO ji = i1, i2
+            idx = INT ( i1 + (j1-1)*jpai, KIND = il)
+            wo2a (:,idx) = wo2a (:,idx3)
+            ko2a (:,idx) = ko2a (:,idx3)
+            nva  (idx)   = nva (idx3)
+         END DO
+      END DO
+      !!
+   END SUBROUTINE correct2
+   !!
+   SUBROUTINE correct_t106_orca2
+      !!
+      IMPLICIT NONE
+      !!
+      IF ( catyp(1:8) == 'gaussian' ) THEN
+         IF ( jpai == 320 ) THEN
+            CALL correct2 ( 171, 188, 5, 5, 165, 11)
+            CALL correct2 ( 154, 184, 6, 6, 165, 11)
+            CALL correct2 ( 148, 184, 7, 7, 165, 11)
+            CALL correct2 ( 261, 268, 7, 7, 270, 11)
+            CALL correct2 ( 145, 184, 8, 8, 165, 11)
+            CALL correct2 ( 259, 284, 8, 8, 270, 11)
+
+            CALL correct2 ( 144, 186, 9, 9, 165, 11)
+
+            CALL correct ( 253,  9,270, 11) 
+            CALL correct ( 254,  9,270, 11)
+            CALL correct ( 255,  9,270, 11)
+            CALL correct ( 256,  9,270, 11)
+            CALL correct ( 257,  9,270, 11)
+            CALL correct ( 258,  9,270, 11)
+            CALL correct ( 259,  9,270, 11)
+            CALL correct ( 260,  9,270, 11)
+            CALL correct ( 261,  9,270, 11)
+            CALL correct ( 262,  9,270, 11)
+            CALL correct ( 263,  9,270, 11)
+            CALL correct ( 264,  9,270, 11)
+            CALL correct ( 265,  9,270, 11)
+            CALL correct ( 266,  9,270, 11)
+            CALL correct ( 271,  9,270, 11)
+            CALL correct ( 272,  9,270, 11)
+            CALL correct ( 273,  9,270, 11)
+            CALL correct ( 282,  9,270, 11)
+            CALL correct ( 283,  9,270, 11)
+            CALL correct ( 284,  9,270, 11)
+            CALL correct ( 285,  9,270, 11)
+            CALL correct ( 286,  9,270, 11)
+            CALL correct ( 287,  9,270, 11)
+            CALL correct ( 288,  9,270, 11)
+            CALL correct ( 289,  9,270, 11)
+            CALL correct ( 290,  9,270, 11)
+            CALL correct ( 291,  9,270, 11)
+            CALL correct ( 293,  9,270, 11)
+
+            CALL correct ( 145, 10,165, 11)
+            CALL correct ( 146, 10,165, 11)
+            CALL correct ( 147, 10,165, 11)
+            CALL correct ( 148, 10,165, 11)
+            CALL correct ( 149, 10,165, 11)
+            CALL correct ( 150, 10,165, 11)
+            CALL correct ( 151, 10,165, 11)
+            CALL correct ( 152, 10,165, 11)
+            CALL correct ( 153, 10,165, 11)
+            CALL correct ( 154, 10,165, 11)
+            CALL correct ( 155, 10,165, 11)
+            CALL correct ( 156, 10,165, 11)
+            CALL correct ( 157, 10,165, 11)
+            CALL correct ( 158, 10,165, 11)
+            CALL correct ( 159, 10,165, 11)
+            CALL correct ( 160, 10,165, 11)
+            CALL correct ( 161, 10,165, 11)
+            CALL correct ( 162, 10,165, 11)
+            CALL correct ( 163, 10,165, 11)
+            CALL correct ( 164, 10,165, 11)
+            CALL correct ( 165, 10,165, 11)
+            CALL correct ( 166, 10,165, 11)
+            CALL correct ( 167, 10,165, 11)
+            CALL correct ( 168, 10,165, 11)
+            CALL correct ( 169, 10,165, 11)
+            CALL correct ( 170, 10,165, 11)
+            CALL correct ( 171, 10,165, 11)
+            CALL correct ( 172, 10,165, 11)
+            CALL correct ( 173, 10,165, 11)
+            CALL correct ( 174, 10,165, 11)
+            CALL correct ( 175, 10,165, 11)
+            CALL correct ( 179, 10,165, 11)
+            CALL correct ( 180, 10,165, 11)
+            CALL correct ( 181, 10,165, 11)
+            CALL correct ( 182, 10,165, 11)
+
+            CALL correct ( 249, 10,270, 11)
+            CALL correct ( 250, 10,270, 11)
+            CALL correct ( 251, 10,270, 11)
+            CALL correct ( 252, 10,270, 11)
+            CALL correct ( 253, 10,270, 11)
+            CALL correct ( 254, 10,270, 11)
+            CALL correct ( 255, 10,270, 11)
+            CALL correct ( 256, 10,270, 11)
+            CALL correct ( 257, 10,270, 11)
+            CALL correct ( 258, 10,270, 11)
+            CALL correct ( 259, 10,270, 11)
+            CALL correct ( 260, 10,270, 11)
+            CALL correct ( 261, 10,270, 11)
+            CALL correct ( 262, 10,270, 11)
+            CALL correct ( 263, 10,270, 11)
+            CALL correct ( 264, 10,270, 11)
+            CALL correct ( 265, 10,270, 11)
+            CALL correct ( 266, 10,270, 11)
+            CALL correct ( 267, 10,270, 11)
+            CALL correct ( 268, 10,270, 11)
+            CALL correct ( 269, 10,270, 11)
+            CALL correct ( 270, 10,270, 11)
+            CALL correct ( 271, 10,270, 11)
+            CALL correct ( 272, 10,270, 11)
+            CALL correct ( 273, 10,270, 11)
+            CALL correct ( 282, 10,270, 11)
+            CALL correct ( 283, 10,270, 11)
+            CALL correct ( 284, 10,270, 11)
+            CALL correct ( 285, 10,270, 11)
+            CALL correct ( 286, 10,270, 11)
+            CALL correct ( 287, 10,270, 11)
+            CALL correct ( 288, 10,270, 11)
+            CALL correct ( 289, 10,270, 11)
+
+            CALL correct ( 248, 11,270, 11)
+            CALL correct ( 249, 11,270, 11)
+            CALL correct ( 250, 11,270, 11)
+            CALL correct ( 253, 11,270, 11)
+            CALL correct ( 254, 11,270, 11)
+            CALL correct ( 255, 11,270, 11)
+            CALL correct ( 256, 11,270, 11)
+            CALL correct ( 261, 11,270, 11)
+            CALL correct ( 262, 11,270, 11)
+            CALL correct ( 263, 11,270, 11)
+            CALL correct ( 264, 11,270, 11)
+            CALL correct ( 190, 12,188, 12)
+            CALL correct ( 253, 12,270, 12)
+            CALL correct ( 261, 12,270, 12)
+            CALL correct ( 262, 12,270, 12)
+            CALL correct ( 263, 12,270, 12)
+            CALL correct ( 264, 12,270, 12)
+
+            CALL correct ( 264, 13,265, 13)
+
+            CALL correct ( 209, 14,207, 14)
+            CALL correct ( 210, 14,207, 14)
+            CALL correct ( 211, 14,207, 14)
+            CALL correct ( 230, 14,229, 14)
+            CALL correct ( 231, 14,229, 14)
+
+            CALL correct ( 256, 15,253, 15)
+
+            CALL correct ( 255, 16,254, 16)
+            CALL correct ( 256, 16,254, 16)
+            CALL correct ( 257, 16,254, 16)
+            CALL correct ( 260, 16,254, 16)
+            CALL correct ( 261, 16,254, 16)
+
+            CALL correct (  64, 17, 64, 18)
+            CALL correct ( 255, 17,254, 17)
+            CALL correct ( 314, 17,313, 17)
+
+            CALL correct (  62, 18, 64, 18)
+            CALL correct (  63, 18, 64, 18)
+            CALL correct ( 260, 18,257, 18)
+
+            CALL correct ( 261, 19,260, 19)
+
+            CALL correct ( 261, 20,260, 20)
+
+            CALL correct ( 257, 33,256, 33)
+            CALL correct ( 258, 33,256, 33)
+
+            CALL correct ( 255, 34,254, 34)
+
+            CALL correct ( 255, 35,254, 34)
+
+            CALL correct ( 255, 41,254, 41)
+
+            CALL correct ( 152, 42,151, 42)
+            CALL correct ( 255, 42,254, 42)
+            CALL correct ( 256, 42,254, 42)
+
+            CALL correct ( 255, 43,254, 43)
+            CALL correct ( 256, 43,254, 43)
+
+            CALL correct ( 156, 44,155, 44)
+
+            CALL correct ( 124, 49,123, 49)
+            CALL correct ( 156, 49,155, 49)
+
+            CALL correct (  17, 52, 16, 52)
+
+            CALL correct ( 102, 57,101, 57)
+
+            CALL correct (  31, 58, 32, 58)
+            CALL correct (  40, 58, 39, 58)
+            CALL correct ( 102, 58,101, 58)
+            CALL correct ( 102, 60,101, 60)
+            CALL correct ( 131, 64,132, 64)
+            CALL correct ( 125, 65,125, 66)
+            CALL correct ( 126, 65,126, 66)
+            CALL correct ( 131, 65,132, 65)
+            CALL correct ( 122, 67,123, 67)
+            CALL correct ( 122, 68,123, 68)
+            CALL correct (  95, 75, 94, 75)
+            CALL correct ( 121, 78,121, 79)
+            CALL correct (  30, 79, 38, 79)
+            CALL correct (  30, 80, 38, 80)
+            CALL correct (  31, 80, 38, 80)
+            CALL correct ( 115, 81,116, 81)
+            CALL correct (  18, 82,  9, 82)
+            CALL correct (  92, 82, 94, 82)
+            CALL correct ( 115, 82,116, 82)
+            CALL correct (  90, 83, 89, 84)
+            CALL correct (  91, 83, 90, 84)
+            CALL correct (  44, 85, 45, 85)
+            CALL correct ( 111, 87,110, 87)
+            CALL correct (  88, 89, 87, 89)
+            CALL correct ( 111, 89,110, 89)
+            CALL correct ( 246, 89,245, 89)
+            CALL correct ( 257, 89,253, 89)
+            CALL correct (  88, 90, 87, 90)
+            CALL correct ( 111, 90,110, 90)
+            CALL correct ( 264, 90,265, 90)
+            CALL correct (  88, 91, 87, 91)
+            CALL correct ( 111, 91,110, 91)
+            CALL correct (  14, 92, 41, 92)
+            CALL correct (  88, 92, 87, 92)
+            CALL correct (  13, 93, 41, 92)
+            CALL correct (  39, 93, 41, 92)
+            CALL correct (  88, 93, 87, 93)
+            CALL correct (  39, 94, 38, 94)
+            CALL correct ( 243, 95,244, 95)
+            CALL correct (  38, 96, 37, 96)
+            CALL correct ( 243, 96,244, 96)
+            CALL correct ( 243, 97,244, 97)
+            CALL correct (  37, 98, 36, 98)
+            CALL correct ( 255, 98,253, 98)
+            CALL correct ( 256, 98,253, 98)
+            CALL correct ( 259, 98,260, 98)
+            CALL correct (  35,101, 34,101)
+            CALL correct (  52,102, 53,102)
+            CALL correct (  47,103, 53,102)
+            CALL correct (  48,103, 53,102)
+            CALL correct (  49,103, 53,102)
+            CALL correct (  50,103, 53,102)
+            CALL correct (  52,103, 53,102)
+            CALL correct (  53,103, 53,102)
+            CALL correct (  54,103, 53,102)
+            CALL correct (  55,103, 53,102)
+            CALL correct (  57,103, 53,102)
+            CALL correct (  58,103, 53,102)
+            CALL correct (  59,103, 53,102)
+            CALL correct (  60,103, 53,102)
+            CALL correct ( 223,103,221,103)
+            CALL correct ( 224,103,221,103)
+            CALL correct (  46,104, 53,102)
+            CALL correct (  47,104, 53,102)
+            CALL correct (  48,104, 53,102)
+            CALL correct (  49,104, 53,102)
+            CALL correct (  50,104, 53,102)
+            CALL correct (  51,104, 53,102)
+            CALL correct ( 223,104,222,104)
+            CALL correct (  45,105, 53,102)
+            CALL correct (  46,105, 53,102)
+            CALL correct (  47,105, 53,102)
+            CALL correct ( 222,105,219,105)
+            CALL correct (  45,106, 53,102)
+            CALL correct (  46,106, 53,102)
+            CALL correct ( 221,106,219,106)
+            CALL correct ( 236,106,237,106)
+            CALL correct (  44,107, 53,102)
+            CALL correct (  45,107, 53,102)
+            CALL correct ( 220,107,218,107)
+            CALL correct ( 220,108,219,108)
+            CALL correct ( 118,109,119,109)
+            CALL correct ( 108,111,109,111)
+            CALL correct (  45,114, 24,110)
+            CALL correct (  46,114, 24,110)
+            CALL correct (  47,114, 24,110)
+            CALL correct (  48,114, 24,110)
+            CALL correct (  45,115, 24,110)
+            CALL correct (  46,115, 24,110)
+            CALL correct (  47,115, 24,110)
+            CALL correct (  48,115, 24,110)
+            CALL correct ( 106,115,107,115)
+            CALL correct ( 125,115,124,115)
+            CALL correct (  45,116, 24,111)
+            CALL correct (  46,116, 24,111)
+            CALL correct (  47,116, 24,111)
+            CALL correct (  48,116, 24,111)
+            CALL correct (  26,117, 24,111)
+            CALL correct (  45,117, 24,111)
+            CALL correct (  46,117, 24,111)
+            CALL correct (  47,117, 24,111)
+            CALL correct (  48,117, 24,111)
+            CALL correct (  26,118, 24,112)
+            CALL correct (  27,118, 24,112)
+            CALL correct (  28,118, 24,112)
+            CALL correct (  29,118, 24,112)
+            CALL correct (  30,118, 24,112)
+            CALL correct (  31,118, 24,112)
+            CALL correct (  32,118, 24,112)
+            CALL correct (  33,118, 24,112)
+            CALL correct (  34,118, 24,112)
+            CALL correct (  35,118, 24,112)
+            CALL correct (  36,118, 24,112)
+            CALL correct (  37,118, 24,112)
+            CALL correct (  38,118, 24,112)
+            CALL correct (  44,118, 24,112)
+            CALL correct (  45,118, 24,112)
+            CALL correct (  46,118, 24,112)
+            CALL correct (  47,118, 24,112)
+            CALL correct ( 244,118,259,118)
+            CALL correct ( 248,118,259,118)
+            CALL correct ( 249,118,259,118)
+            CALL correct (  26,119, 24,112)
+            CALL correct (  27,119, 24,112)
+            CALL correct (  28,119, 24,112)
+            CALL correct (  29,119, 24,112)
+            CALL correct (  30,119, 24,112)
+            CALL correct (  31,119, 24,112)
+            CALL correct (  32,119, 24,112)
+            CALL correct (  33,119, 24,112)
+            CALL correct (  34,119, 24,112)
+            CALL correct (  35,119, 24,112)
+            CALL correct (  36,119, 24,112)
+            CALL correct (  44,119, 24,112)
+            CALL correct (  45,119, 24,112)
+            CALL correct (  46,119, 24,112)
+            CALL correct ( 243,119,259,119)
+            CALL correct ( 244,119,259,119)
+
+            CALL correct (  27,120, 24,113)
+            CALL correct (  28,120, 24,113)
+            CALL correct (  29,120, 24,113)
+            CALL correct (  30,120, 24,113)
+            CALL correct (  31,120, 24,113)
+            CALL correct (  32,120, 24,113)
+            CALL correct (  33,120, 24,113)
+            CALL correct (  34,120, 24,113)
+            CALL correct (  35,120, 24,113)
+            CALL correct (  43,120, 24,113)
+            CALL correct (  44,120, 24,113)
+            CALL correct (  45,120, 24,113)
+            CALL correct (  46,120, 24,113)
+            CALL correct (  53,120, 24,113)
+            CALL correct (  54,120, 24,113)
+            CALL correct (  55,120, 24,113)
+
+            CALL correct ( 244,120,259,120)
+            CALL correct ( 247,120,259,120)
+            CALL correct ( 248,120,259,120)
+            CALL correct ( 264,120,265,120)
+
+            CALL correct (  28,121, 24,114)
+            CALL correct (  29,121, 24,114)
+            CALL correct (  30,121, 24,114)
+            CALL correct (  33,121, 24,114)
+            CALL correct (  34,121, 24,114)
+            CALL correct (  44,121, 24,114)
+            CALL correct (  45,121, 24,114)
+            CALL correct (  46,121, 24,114)
+            CALL correct (  47,121, 24,114)
+            CALL correct (  54,121, 24,114)
+            CALL correct (  55,121, 24,114)
+
+            CALL correct ( 244,121,267,121)
+            CALL correct ( 245,121,267,121)
+            CALL correct ( 247,121,267,121)
+            CALL correct ( 248,121,267,121)
+            CALL correct ( 249,121,267,121)
+            CALL correct ( 320,121,319,121)
+
+            CALL correct (  29,122, 24,115)
+            CALL correct (  33,122, 24,115)
+            CALL correct (  34,122, 24,115)
+            CALL correct (  35,122, 24,115)
+            CALL correct (  46,122, 24,115)
+            CALL correct (  47,122, 24,115)
+            CALL correct (  55,122, 24,115)
+
+            CALL correct ( 128,122,129,122)
+            CALL correct ( 244,122,264,122)
+
+            CALL correct ( 128,123,129,123)
+            CALL correct ( 241,123,264,123)
+            CALL correct ( 242,123,264,123)
+            CALL correct ( 243,123,264,123)
+            CALL correct ( 244,123,264,123)
+            CALL correct ( 245,123,264,123)
+
+            CALL correct ( 126,124,129,124)
+            CALL correct ( 127,124,129,124)
+            CALL correct ( 243,124,264,124)
+            CALL correct ( 260,124,264,124)
+
+            CALL correct (   1,125,319,125)
+            CALL correct ( 126,125,129,125)
+            CALL correct ( 127,125,129,125)
+            CALL correct ( 262,125,263,125)
+            CALL correct ( 269,125,268,125)
+            CALL correct ( 320,125,319,125)
+            CALL correct (   2,126,  2,128)
+            CALL correct ( 126,126,129,126)
+            CALL correct ( 127,126,129,126)
+            CALL correct ( 140,126,139,126)
+            CALL correct ( 269,126,272,126)
+            CALL correct ( 270,126,272,126)
+            CALL correct (   3,127,  3,128)
+            CALL correct (   4,127,  4,128)
+            CALL correct ( 140,127,139,127)
+            CALL correct ( 234,127,249,127)
+            CALL correct (   6,128,  5,128)
+            CALL correct (  97,128,129,128)
+            CALL correct ( 127,128,129,128)
+            CALL correct ( 232,128,249,128)
+            CALL correct ( 233,128,249,128)
+            CALL correct ( 234,128,249,128)
+            CALL correct ( 316,128,312,128)
+            CALL correct ( 317,128,312,128)
+            CALL correct (   8,129,  7,129)
+            CALL correct (  11,129,  7,129)
+            CALL correct (  12,129,  7,129)
+            CALL correct (  13,129,  7,129)
+            CALL correct (  14,129,  7,129)
+            CALL correct (  15,129,  7,129)
+            CALL correct (  18,129,  7,129)
+            CALL correct (  98,129,124,129)
+            CALL correct ( 123,129,124,129)
+            CALL correct ( 313,129,312,129)
+            CALL correct ( 317,129,316,129)
+            CALL correct ( 318,129,316,129)
+            CALL correct (  11,130,  8,130)
+            CALL correct (  12,130,  8,130)
+            CALL correct (  14,130,  8,130)
+            CALL correct (  15,130,  8,130)
+            CALL correct (  16,130,  8,130)
+            CALL correct (  17,130,  8,130)
+            CALL correct (  18,130,  8,130)
+            CALL correct (  19,130,  8,130)
+            CALL correct (  11,131,  8,131)
+            CALL correct (  12,131,  8,131)
+            CALL correct (  16,131,  8,131)
+            CALL correct (  17,131,  8,131)
+            CALL correct (  18,131,  8,131)
+            CALL correct (  19,131,  8,131)
+            CALL correct (   9,132,  8,132)
+            CALL correct (  10,132,  8,132)
+            CALL correct (  11,132,  8,132)
+            CALL correct (  16,132,  8,132)
+            CALL correct (  17,132,  8,132)
+            CALL correct (  18,132,  8,132)
+            CALL correct (  19,132,  8,132)
+            CALL correct (  20,132,  8,132)
+            CALL correct (  21,132,  8,132)
+            CALL correct (  22,132,  8,132)
+            CALL correct ( 180,132,179,132)
+            CALL correct (  10,133,  6,133)
+            CALL correct (  13,133,  6,133)
+            CALL correct (  17,133,  6,133)
+            CALL correct (  18,133,  6,133)
+            CALL correct (  19,133,  6,133)
+            CALL correct (  20,133,  6,133)
+            CALL correct (  21,133,  6,133)
+            CALL correct (  18,134,  5,134)
+            CALL correct (  19,134,  5,134)
+            CALL correct (  20,134,  5,134)
+            CALL correct (  21,134,  5,134)
+            CALL correct (  22,134,  5,134)
+            CALL correct (  23,134,  5,134)
+            CALL correct (  24,134,  5,134)
+            CALL correct (  25,134,  5,134)
+            CALL correct (  26,134,  5,134)
+            CALL correct ( 151,134,152,134)
+            CALL correct ( 186,134,186,133)
+            CALL correct (  17,135,  5,135)
+            CALL correct (  18,135,  5,135)
+            CALL correct (  19,135,  5,135)
+            CALL correct (  20,135,  5,135)
+            CALL correct (  28,135,  5,135)
+            CALL correct (  29,135,  5,135)
+            CALL correct ( 145,135,143,135)
+            CALL correct ( 146,135,143,135)
+            CALL correct ( 218,135,238,135)
+            CALL correct ( 219,135,238,135)
+            CALL correct (  17,136,  6,136)
+            CALL correct (  18,136,  6,136)
+            CALL correct (  19,136,  6,136)
+            CALL correct (  32,136,  6,136)
+            CALL correct ( 160,136,161,136)
+            CALL correct ( 219,136,239,136)
+            CALL correct (   8,137,  7,137)
+            CALL correct (  18,137,  7,137)
+            CALL correct (  19,137,  7,137)
+            CALL correct (  20,137,  7,137)
+            CALL correct ( 161,137,162,137)
+            CALL correct ( 175,137,174,137)
+            CALL correct ( 176,137,174,137)
+            CALL correct ( 247,137,248,137)
+            CALL correct (  10,138,  9,138)
+            CALL correct (  20,138,  9,138)
+            CALL correct (  21,138,  9,138)
+            CALL correct (  22,138,  9,138)
+            CALL correct (  33,138, 37,141)
+            CALL correct (  34,138, 37,141)
+            CALL correct ( 161,138,162,138)
+            CALL correct ( 175,138,173,138)
+            CALL correct ( 176,138,173,138)
+            CALL correct ( 177,138,173,138)
+            CALL correct ( 300,138,299,138)
+            CALL correct (  21,139, 11,139)
+            CALL correct (  22,139, 11,139)
+            CALL correct (  23,139, 11,139)
+            CALL correct (  32,139, 37,141)
+            CALL correct (  33,139, 37,141)
+            CALL correct (  34,139, 37,141)
+            CALL correct (  35,139, 37,141)
+            CALL correct (  36,139, 37,141)
+            CALL correct ( 162,139,162,138)
+            CALL correct ( 213,139,246,139)
+            CALL correct ( 214,139,246,139)
+            CALL correct ( 244,139,246,139)
+            CALL correct ( 262,139,265,139)
+            CALL correct ( 263,139,265,139)
+            CALL correct (  38,140, 37,141)
+            CALL correct (  39,140, 37,141)
+            CALL correct (  40,140, 37,141)
+            CALL correct (  65,140, 44,141)
+            CALL correct ( 176,140,175,140)
+            CALL correct ( 177,140,175,140)
+            CALL correct ( 213,140,246,140)
+            CALL correct ( 214,140,246,140)
+            CALL correct ( 258,140,255,140)
+            CALL correct ( 301,140,302,140)
+            CALL correct ( 309,140,308,140)
+            CALL correct (  66,141, 44,141)
+            CALL correct (  67,141, 44,141)
+            CALL correct ( 168,141,169,141)
+            CALL correct ( 220,141,249,141)
+            CALL correct ( 221,141,249,141)
+            CALL correct ( 222,141,249,141)
+            CALL correct ( 224,141,249,141)
+            CALL correct ( 225,141,249,141)
+            CALL correct ( 230,141,249,141)
+            CALL correct ( 231,141,249,141)
+            CALL correct ( 232,141,249,141)
+            CALL correct ( 233,141,249,141)
+            CALL correct ( 236,141,249,141)
+            CALL correct ( 243,141,249,141)
+            CALL correct ( 244,141,249,141)
+            CALL correct ( 308,141,309,141)
+            CALL correct (  61,142, 54,142)
+            CALL correct (  66,142, 54,142)
+            CALL correct (  67,142, 54,142)
+            CALL correct ( 167,142,168,142)
+            CALL correct ( 217,142,217,143)
+            CALL correct ( 226,142,249,142)
+            CALL correct ( 227,142,249,142)
+            CALL correct ( 228,142,249,142)
+            CALL correct ( 230,142,249,142)
+            CALL correct ( 231,142,249,142)
+            CALL correct ( 232,142,249,142)
+            CALL correct ( 233,142,249,142)
+            CALL correct ( 236,142,249,142)
+            CALL correct ( 237,142,249,142)
+            CALL correct ( 241,142,249,142)
+            CALL correct ( 243,142,249,142)
+            CALL correct ( 244,142,249,142)
+            CALL correct ( 245,142,249,142)
+            CALL correct ( 261,142,262,142)
+            CALL correct ( 302,142,303,142)
+            CALL correct ( 307,142,306,142)
+            CALL correct ( 318,142,317,142)
+            CALL correct (  16,143, 15,143)
+            CALL correct (  66,143, 60,143)
+            CALL correct ( 161,143,162,143)
+            CALL correct ( 166,143,165,143)
+            CALL correct ( 231,143,251,143)
+            CALL correct ( 232,143,251,143)
+            CALL correct ( 233,143,251,143)
+            CALL correct ( 234,143,251,143)
+            CALL correct ( 235,143,251,143)
+            CALL correct ( 240,143,251,143)
+            CALL correct ( 241,143,251,143)
+            CALL correct ( 242,143,251,143)
+            CALL correct ( 243,143,251,143)
+            CALL correct ( 244,143,251,143)
+            CALL correct ( 302,143,303,143)
+            CALL correct ( 307,143,306,143)
+            CALL correct (   9,144,  8,144)
+            CALL correct (  66,144, 60,144)
+            CALL correct ( 117,144,117,145)
+            CALL correct ( 118,144,118,145)
+            CALL correct ( 138,144,139,144)
+            CALL correct ( 153,144,154,144)
+            CALL correct ( 157,144,156,144)
+            CALL correct ( 165,144,166,144)
+            CALL correct ( 183,144,184,144)
+            CALL correct ( 229,144,217,144)
+            CALL correct ( 230,144,217,144)
+            CALL correct ( 231,144,217,144)
+            CALL correct ( 232,144,217,144)
+            CALL correct ( 233,144,217,144)
+            CALL correct ( 234,144,217,144)
+            CALL correct ( 235,144,217,144)
+            CALL correct ( 239,144,217,144)
+            CALL correct ( 240,144,217,144)
+            CALL correct ( 241,144,217,144)
+            CALL correct ( 273,144,272,144)
+            CALL correct ( 274,144,272,144)
+            CALL correct ( 299,144,303,144)
+            CALL correct ( 302,144,303,144)
+            CALL correct ( 306,144,305,144)
+            CALL correct (  68,145, 62,145)
+            CALL correct (  69,145, 62,145)
+            CALL correct (  70,145, 62,145)
+            CALL correct (  72,145, 62,145)
+            CALL correct (  73,145, 62,145)
+            CALL correct ( 116,145,117,145)
+            CALL correct ( 124,145,131,145)
+            CALL correct ( 125,145,131,145)
+            CALL correct ( 147,145,148,145)
+            CALL correct ( 150,145,149,145)
+            CALL correct ( 157,145,158,145)
+            CALL correct ( 161,145,160,145)
+            CALL correct ( 165,145,166,145)
+            CALL correct ( 215,145,209,145)
+            CALL correct ( 225,145,209,145)
+            CALL correct ( 228,145,209,145)
+            CALL correct ( 229,145,209,145)
+            CALL correct ( 230,145,209,145)
+            CALL correct ( 231,145,209,145)
+            CALL correct ( 236,145,209,145)
+            CALL correct ( 238,145,209,145)
+            CALL correct ( 239,145,209,145)
+            CALL correct ( 240,145,209,145)
+            CALL correct ( 241,145,209,145)
+            CALL correct ( 245,145,209,145)
+            CALL correct ( 301,145,302,145)
+            CALL correct ( 306,145,305,145)
+            CALL correct ( 310,145,311,145)
+            CALL correct (  13,146, 12,146)
+            CALL correct (  64,146, 63,146)
+            CALL correct (  98,146,114,146)
+            CALL correct ( 109,146,114,146)
+            CALL correct ( 113,146,114,146)
+            CALL correct ( 131,146,132,146)
+            CALL correct ( 145,146,146,146)
+            CALL correct ( 148,146,147,146)
+            CALL correct ( 151,146,152,146)
+            CALL correct ( 154,146,153,146)
+            CALL correct ( 161,146,162,146)
+            CALL correct ( 164,146,163,146)
+            CALL correct ( 219,146,253,146)
+            CALL correct ( 220,146,253,146)
+            CALL correct ( 221,146,253,146)
+            CALL correct ( 222,146,253,146)
+            CALL correct ( 223,146,253,146)
+            CALL correct ( 224,146,253,146)
+            CALL correct ( 225,146,253,146)
+            CALL correct ( 226,146,253,146)
+            CALL correct ( 228,146,253,146)
+            CALL correct ( 229,146,253,146)
+            CALL correct ( 230,146,253,146)
+            CALL correct ( 231,146,253,146)
+            CALL correct ( 235,146,253,146)
+            CALL correct ( 236,146,253,146)
+            CALL correct ( 241,146,253,146)
+            CALL correct ( 242,146,253,146)
+            CALL correct ( 245,146,253,146)
+            CALL correct ( 246,146,253,146)
+            CALL correct ( 249,146,253,146)
+            CALL correct ( 303,146,304,146)
+            CALL correct ( 306,146,305,146)
+            CALL correct ( 309,146,310,146)
+            CALL correct (  74,147, 74,148)
+            CALL correct ( 100,147,102,147)
+            CALL correct ( 125,147,124,147)
+            CALL correct ( 126,147,124,147)
+            CALL correct ( 127,147,124,147)
+            CALL correct ( 128,147,124,147)
+            CALL correct ( 129,147,124,147)
+            CALL correct ( 130,147,124,147)
+            CALL correct ( 133,147,134,147)
+            CALL correct ( 152,147,153,147)
+            CALL correct ( 155,147,154,147)
+            CALL correct ( 158,147,159,147)
+            CALL correct ( 161,147,160,147)
+            CALL correct ( 164,147,165,147)
+            CALL correct ( 218,147,217,147)
+            CALL correct ( 219,147,217,147)
+            CALL correct ( 220,147,217,147)
+            CALL correct ( 222,147,217,147)
+            CALL correct ( 223,147,217,147)
+            CALL correct ( 224,147,217,147)
+            CALL correct ( 225,147,217,147)
+            CALL correct ( 226,147,217,147)
+            CALL correct ( 227,147,217,147)
+            CALL correct ( 228,147,217,147)
+            CALL correct ( 229,147,217,147)
+            CALL correct ( 230,147,217,147)
+            CALL correct ( 231,147,217,147)
+            CALL correct ( 232,147,217,147)
+            CALL correct ( 233,147,217,147)
+            CALL correct ( 234,147,217,147)
+            CALL correct ( 235,147,217,147)
+            CALL correct ( 236,147,217,147)
+            CALL correct ( 238,147,250,147)
+            CALL correct ( 239,147,250,147)
+            CALL correct ( 240,147,250,147)
+            CALL correct ( 242,147,250,147)
+            CALL correct ( 247,147,250,147)
+            CALL correct ( 306,147,307,147)
+            CALL correct ( 309,147,308,147)
+            CALL correct ( 312,147,313,147)
+            CALL correct ( 317,147,316,147)
+            CALL correct ( 320,147,319,147)
+            CALL correct (  27,148, 26,148)
+            CALL correct (  67,148, 68,148)
+            CALL correct (  70,148, 71,148)
+            CALL correct (  73,148, 74,148)
+            CALL correct (  77,148, 78,148)
+            CALL correct (  80,148, 81,148)
+            CALL correct ( 110,148,109,148)
+            CALL correct ( 123,148,122,148)
+            CALL correct ( 130,148,132,148)
+            CALL correct ( 131,148,132,148)
+            CALL correct ( 145,148,144,148)
+            CALL correct ( 150,148,151,148)
+            CALL correct ( 155,148,156,148)
+            CALL correct ( 158,148,159,148)
+            CALL correct ( 163,148,164,148)
+            CALL correct ( 171,148,170,148)
+            CALL correct ( 174,148,175,148)
+            CALL correct ( 217,148,216,148)
+            CALL correct ( 222,148,216,148)
+            CALL correct ( 223,148,216,148)
+            CALL correct ( 227,148,216,148)
+            CALL correct ( 228,148,216,148)
+            CALL correct ( 229,148,216,148)
+            CALL correct ( 230,148,216,148)
+            CALL correct ( 231,148,216,148)
+            CALL correct ( 235,148,216,148)
+            CALL correct ( 236,148,216,148)
+            CALL correct ( 238,148,216,148)
+            CALL correct ( 242,148,250,148)
+            CALL correct ( 243,148,250,148)
+            CALL correct ( 244,148,250,148)
+            CALL correct ( 245,148,250,148)
+            CALL correct ( 304,148,305,148)
+            CALL correct ( 306,148,307,148)
+            CALL correct ( 311,148,312,148)
+            CALL correct ( 316,148,317,148)
+            CALL correct (   4,149,  5,149)
+            CALL correct (  28,149, 27,149)
+            CALL correct (  58,149, 59,149)
+            CALL correct (  70,149, 69,149)
+            CALL correct (  73,149, 74,149)
+            CALL correct (  76,149, 77,149)
+            CALL correct (  81,149, 80,149)
+            CALL correct (  88,149, 89,149)
+            CALL correct ( 111,149,110,149)
+            CALL correct ( 115,149,116,149)
+            CALL correct ( 120,149,121,149)
+            CALL correct ( 151,149,150,149)
+            CALL correct ( 153,149,154,149)
+            CALL correct ( 158,149,157,149)
+            CALL correct ( 160,149,161,149)
+            CALL correct ( 165,149,164,149)
+            CALL correct ( 170,149,171,149)
+            CALL correct ( 218,149,214,149)
+            CALL correct ( 219,149,214,149)
+            CALL correct ( 220,149,214,149)
+            CALL correct ( 221,149,214,149)
+            CALL correct ( 222,149,214,149)
+            CALL correct ( 223,149,214,149)
+            CALL correct ( 224,149,214,149)
+            CALL correct ( 225,149,214,149)
+            CALL correct ( 226,149,214,149)
+            CALL correct ( 227,149,214,149)
+            CALL correct ( 228,149,214,149)
+            CALL correct ( 229,149,214,149)
+            CALL correct ( 230,149,214,149)
+            CALL correct ( 231,149,214,149)
+            CALL correct ( 232,149,214,149)
+            CALL correct ( 233,149,214,149)
+            CALL correct ( 234,149,214,149)
+            CALL correct ( 235,149,214,149)
+            CALL correct ( 238,149,251,149)
+            CALL correct ( 239,149,251,149)
+            CALL correct ( 240,149,251,149)
+            CALL correct ( 241,149,251,149)
+            CALL correct ( 242,149,251,149)
+            CALL correct ( 303,149,304,149)
+            CALL correct ( 306,149,305,149)
+            CALL correct ( 308,149,309,149)
+            CALL correct ( 313,149,312,149)
+            CALL correct ( 315,149,316,149)
+            CALL correct ( 320,149,319,149)
+            CALL correct (  22,150, 21,150)
+            CALL correct (  28,150, 27,150)
+            CALL correct (  32,150, 33,150)
+            CALL correct (  35,150, 36,150)
+            CALL correct (  57,150, 56,150)
+            CALL correct (  66,150, 65,150)
+            CALL correct (  68,150, 69,150)
+            CALL correct (  71,150, 72,150)
+            CALL correct (  73,150, 74,150)
+            CALL correct (  78,150, 77,150)
+            CALL correct (  80,150, 81,150)
+            CALL correct ( 112,150,111,150)
+            CALL correct ( 115,150,116,150)
+            CALL correct ( 119,150,118,150)
+            CALL correct ( 122,150,121,150)
+            CALL correct ( 126,150,125,150)
+            CALL correct ( 139,150,140,150)
+            CALL correct ( 145,150,146,150)
+            CALL correct ( 147,150,148,150)
+            CALL correct ( 154,150,155,150)
+            CALL correct ( 156,150,157,150)
+            CALL correct ( 158,150,159,150)
+            CALL correct ( 160,150,161,150)
+            CALL correct ( 162,150,163,150)
+            CALL correct ( 169,150,170,150)
+            CALL correct ( 171,150,172,150)
+            CALL correct ( 230,150,229,150)
+            CALL correct ( 231,150,229,150)
+            CALL correct ( 233,150,229,150)
+            CALL correct ( 234,150,229,150)
+            CALL correct ( 237,150,229,150)
+            CALL correct ( 238,150,229,150)
+            CALL correct ( 239,150,229,150)
+            CALL correct ( 240,150,229,150)
+            CALL correct ( 241,150,229,150)
+            CALL correct ( 242,150,229,150)
+            CALL correct ( 243,150,229,150)
+            CALL correct ( 256,150,255,150)
+            CALL correct ( 257,150,255,150)
+            CALL correct ( 303,150,305,150)
+            CALL correct ( 304,150,305,150)
+            CALL correct ( 306,150,307,150)
+            CALL correct ( 308,150,309,150)
+            CALL correct ( 310,150,311,150)
+            CALL correct ( 312,150,313,150)
+            CALL correct (   1,151,  2,151)
+            CALL correct (  19,151, 24,151)
+            CALL correct (  20,151, 24,151)
+            CALL correct (  21,151, 24,151)
+            CALL correct (  22,151, 24,151)
+            CALL correct (  23,151, 24,151)
+            CALL correct (  28,151, 29,151)
+            CALL correct (  31,151, 32,151)
+            CALL correct (  34,151, 35,151)
+            CALL correct (  37,151, 38,151)
+            CALL correct (  55,151, 56,151)
+            CALL correct (  71,151, 72,151)
+            CALL correct (  73,151, 74,151)
+            CALL correct (  75,151, 76,151)
+            CALL correct (  77,151, 78,151)
+            CALL correct (  79,151, 80,151)
+            CALL correct (  81,151, 83,151)
+            CALL correct (  90,151, 90,150)
+            CALL correct ( 115,151,116,151)
+            CALL correct ( 118,151,119,151)
+            CALL correct ( 121,151,122,151)
+            CALL correct ( 129,151,130,151)
+            CALL correct ( 146,151,147,151)
+            CALL correct ( 148,151,149,151)
+            CALL correct ( 150,151,151,151)
+            CALL correct ( 152,151,153,151)
+            CALL correct ( 154,151,155,151)
+            CALL correct ( 156,151,157,151)
+            CALL correct ( 158,151,159,151)
+            CALL correct ( 160,151,161,151)
+            CALL correct ( 162,151,163,151)
+            CALL correct ( 164,151,165,151)
+            CALL correct ( 166,151,167,151)
+            CALL correct ( 168,151,169,151)
+            CALL correct ( 193,151,194,151)
+            CALL correct ( 197,151,198,151)
+            CALL correct ( 201,151,202,151)
+            CALL correct ( 230,151,231,151)
+            CALL correct ( 235,151,234,151)
+            CALL correct ( 236,151,234,151)
+            CALL correct ( 237,151,234,151)
+            CALL correct ( 255,151,255,150)
+            CALL correct ( 256,151,255,150)
+            CALL correct ( 257,151,255,150)
+            CALL correct ( 258,151,255,150)
+            CALL correct ( 259,151,255,150)
+            CALL correct ( 304,151,305,151)
+            CALL correct ( 306,151,307,151)
+            CALL correct ( 308,151,309,151)
+            CALL correct ( 310,151,311,151)
+            CALL correct ( 312,151,313,151)
+            CALL correct ( 314,151,315,151)
+            CALL correct ( 316,151,317,151)
+            CALL correct ( 318,151,319,151)
+            CALL correct (   2,152,  3,152)
+            CALL correct (   4,152,  5,152)
+            CALL correct (  26,152, 27,152)
+            CALL correct (  28,152, 29,152)
+            CALL correct (  31,152, 33,152)
+            CALL correct (  38,152, 39,152)
+            CALL correct (  53,152, 54,152)
+            CALL correct (  58,152, 59,152)
+            CALL correct (  60,152, 61,152)
+            CALL correct (  67,152, 68,152)
+            CALL correct (  69,152, 70,152)
+            CALL correct (  71,152, 72,152)
+            CALL correct (  73,152, 74,152)
+            CALL correct (  75,152, 76,152)
+            CALL correct ( 101,152,102,152)
+            CALL correct ( 103,152,104,152)
+            CALL correct ( 113,152,114,152)
+            CALL correct ( 115,152,116,152)
+            CALL correct ( 118,152,119,152)
+            CALL correct ( 120,152,121,152)
+            CALL correct ( 138,152,139,152)
+            CALL correct ( 140,152,141,152)
+            CALL correct ( 142,152,143,152)
+            CALL correct ( 147,152,148,152)
+            CALL correct ( 149,152,150,152)
+            CALL correct ( 152,152,153,152)
+            CALL correct ( 154,152,155,152)
+            CALL correct ( 156,152,157,152)
+            CALL correct ( 158,152,159,152)
+            CALL correct ( 160,152,161,152)
+            CALL correct ( 163,152,164,152)
+            CALL correct ( 165,152,166,152)
+            CALL correct ( 167,152,168,152)
+            CALL correct ( 191,152,192,152)
+            CALL correct ( 194,152,195,152)
+            CALL correct ( 197,152,198,152)
+            CALL correct ( 200,152,201,152)
+            CALL correct ( 228,152,227,152)
+            CALL correct ( 233,152,232,152)
+            CALL correct ( 244,152,232,152)
+            CALL correct ( 259,152,232,152)
+            CALL correct ( 260,152,232,152)
+            CALL correct ( 261,152,232,152)
+            CALL correct ( 262,152,232,152)
+            CALL correct ( 306,152,307,152)
+            CALL correct ( 308,152,309,152)
+            CALL correct ( 310,152,311,152)
+            CALL correct ( 313,152,314,152)
+            CALL correct ( 315,152,316,152)
+            CALL correct ( 320,152,319,152)
+            CALL correct (   1,153,  2,153)
+            CALL correct (  14,153, 15,153)
+            CALL correct (  20,153, 21,153)
+            CALL correct (  22,153, 23,153)
+            CALL correct (  24,153, 25,153)
+            CALL correct (  26,153, 27,153)
+            CALL correct (  28,153, 29,153)
+            CALL correct (  33,153, 34,153)
+            CALL correct (  35,153, 36,153)
+            CALL correct (  37,153, 38,153)
+            CALL correct (  39,153, 40,153)
+            CALL correct (  43,153, 45,153)
+            CALL correct (  56,153, 57,153)
+            CALL correct (  61,153, 62,153)
+            CALL correct (  64,153, 65,153)
+            CALL correct (  66,153, 67,153)
+            CALL correct (  68,153, 70,153)
+            CALL correct (  69,153, 70,153)
+            CALL correct (  71,153, 72,153)
+            CALL correct (  73,153, 74,153)
+            CALL correct (  76,153, 77,153)
+            CALL correct (  78,153, 79,153)
+            CALL correct (  80,153, 81,153)
+            CALL correct (  83,153, 84,153)
+            CALL correct (  86,153, 87,153)
+            CALL correct (  91,153, 92,153)
+            CALL correct ( 105,153,106,153)
+            CALL correct ( 107,153,108,153)
+            CALL correct ( 109,153,110,153)
+            CALL correct ( 111,153,112,153)
+            CALL correct ( 113,153,114,153)
+            CALL correct ( 115,153,116,153)
+            CALL correct ( 122,153,123,153)
+            CALL correct ( 124,153,125,153)
+            CALL correct ( 126,153,127,153)
+            CALL correct ( 128,153,129,153)
+            CALL correct ( 135,153,136,153)
+            CALL correct ( 141,153,142,153)
+            CALL correct ( 143,153,144,153)
+            CALL correct ( 146,153,147,153)
+            CALL correct ( 148,153,149,153)
+            CALL correct ( 151,153,152,153)
+            CALL correct ( 153,153,154,153)
+            CALL correct ( 156,153,157,153)
+            CALL correct ( 158,153,159,153)
+            CALL correct ( 161,153,162,153)
+            CALL correct ( 163,153,164,153)
+            CALL correct ( 166,153,167,153)
+            CALL correct ( 168,153,169,153)
+            CALL correct ( 171,153,172,153)
+            CALL correct ( 173,153,174,153)
+            CALL correct ( 183,153,184,153)
+            CALL correct ( 185,153,186,153)
+            CALL correct ( 192,153,193,153)
+            CALL correct ( 194,153,195,153)
+            CALL correct ( 197,153,198,153)
+            CALL correct ( 199,153,200,153)
+            CALL correct ( 202,153,203,153)
+            CALL correct ( 231,153,232,153)
+            CALL correct ( 233,153,234,153)
+            CALL correct ( 235,153,236,153)
+            CALL correct ( 240,153,239,153)
+            CALL correct ( 241,153,239,153)
+            CALL correct ( 262,153,239,153)
+            CALL correct ( 263,153,239,153)
+            CALL correct ( 264,153,239,153)
+            CALL correct ( 265,153,239,153)
+            CALL correct ( 266,153,239,153)
+            CALL correct ( 309,153,308,153)
+            CALL correct ( 311,153,310,153)
+            CALL correct ( 313,153,312,153)
+            CALL correct ( 316,153,315,153)
+            CALL correct ( 319,153,318,153)
+            CALL correct (   6,154,  7,154)
+            CALL correct (   9,154, 10,154)
+            CALL correct (  13,154, 14,154)
+            CALL correct (  17,154, 18,154)
+            CALL correct (  21,154, 22,154)
+            CALL correct (  23,154, 24,154)
+            CALL correct (  25,154, 26,154)
+            CALL correct (  28,154, 29,154)
+            CALL correct (  30,154, 31,154)
+            CALL correct (  32,154, 33,154)
+            CALL correct (  34,154, 35,154)
+            CALL correct (  36,154, 37,154)
+            CALL correct (  38,154, 39,154)
+            CALL correct (  41,154, 42,154)
+            CALL correct (  45,154, 46,154)
+            CALL correct (  49,154, 50,154)
+            CALL correct (  57,154, 58,154)
+            CALL correct (  60,154, 61,154)
+            CALL correct (  63,154, 64,154)
+            CALL correct (  65,154, 66,154)
+            CALL correct (  68,154, 69,154)
+            CALL correct (  71,154, 72,154)
+            CALL correct (  73,154, 75,154)
+            CALL correct (  74,154, 75,154)
+            CALL correct (  76,154, 77,154)
+            CALL correct (  79,154, 80,154)
+            CALL correct (  85,154, 86,154)
+            CALL correct (  87,154, 88,154)
+            CALL correct (  94,154, 95,154)
+            CALL correct (  98,154, 99,154)
+            CALL correct ( 102,154,103,154)
+            CALL correct ( 106,154,107,154)
+            CALL correct ( 110,154,111,154)
+            CALL correct ( 114,154,116,154)
+            CALL correct ( 115,154,116,154)
+            CALL correct ( 117,154,118,154)
+            CALL correct ( 119,154,120,154)
+            CALL correct ( 121,154,122,154)
+            CALL correct ( 123,154,124,154)
+            CALL correct ( 130,154,131,154)
+            CALL correct ( 134,154,135,154)
+            CALL correct ( 138,154,139,154)
+            CALL correct ( 144,154,145,154)
+            CALL correct ( 147,154,148,154)
+            CALL correct ( 150,154,151,154)
+            CALL correct ( 153,154,154,154)
+            CALL correct ( 155,154,157,154)
+            CALL correct ( 156,154,157,154)
+            CALL correct ( 158,154,160,154)
+            CALL correct ( 159,154,160,154)
+            CALL correct ( 161,154,163,154)
+            CALL correct ( 162,154,163,154)
+            CALL correct ( 164,154,165,154)
+            CALL correct ( 167,154,168,154)
+            CALL correct ( 176,154,177,154)
+            CALL correct ( 181,154,182,154)
+            CALL correct ( 187,154,188,154)
+            CALL correct ( 193,154,194,154)
+            CALL correct ( 195,154,196,154)
+            CALL correct ( 197,154,198,154)
+            CALL correct ( 199,154,200,154)
+            CALL correct ( 203,154,204,154)
+            CALL correct ( 222,154,223,154)
+            CALL correct ( 229,154,230,154)
+            CALL correct ( 231,154,232,154)
+            CALL correct ( 233,154,234,154)
+            CALL correct ( 235,154,236,154)
+            CALL correct ( 240,154,241,154)
+            CALL correct ( 245,154,244,154)
+            CALL correct ( 267,154,244,154)
+            CALL correct ( 269,154,244,154)
+            CALL correct ( 271,154,244,154)
+            CALL correct ( 273,154,244,154)
+            CALL correct ( 275,154,244,154)
+            CALL correct ( 302,154,304,154)
+            CALL correct ( 303,154,304,154)
+            CALL correct ( 305,154,307,154)
+            CALL correct ( 306,154,307,154)
+            CALL correct ( 308,154,310,154)
+            CALL correct ( 309,154,310,154)
+            CALL correct ( 311,154,313,154)
+            CALL correct ( 312,154,313,154)
+            CALL correct ( 314,154,315,154)
+            CALL correct ( 317,154,318,154)
+            CALL correct ( 320,154,319,154)
+            CALL correct (   2,155,  3,155)
+            CALL correct (   5,155,  6,155)
+            CALL correct (   7,155,  6,155)
+            CALL correct (  10,155, 11,155)
+            CALL correct (  13,155, 14,155)
+            CALL correct (  15,155, 16,155)
+            CALL correct (  18,155, 19,155)
+            CALL correct (  20,155, 21,155)
+            CALL correct (  22,155, 24,155)
+            CALL correct (  23,155, 24,155)
+            CALL correct (  25,155, 26,155)
+            CALL correct (  27,155, 29,155)
+            CALL correct (  28,155, 29,155)
+            CALL correct (  30,155, 31,155)
+            CALL correct (  32,155, 33,155)
+            CALL correct (  35,155, 36,155)
+            CALL correct (  37,155, 38,155)
+            CALL correct (  40,155, 41,155)
+            CALL correct (  46,155, 47,155)
+            CALL correct (  49,155, 50,155)
+            CALL correct (  51,155, 52,155)
+            CALL correct (  54,155, 55,155)
+            CALL correct (  61,155, 62,155)
+            CALL correct (  64,155, 66,155)
+            CALL correct (  65,155, 66,155)
+            CALL correct (  67,155, 69,155)
+            CALL correct (  68,155, 69,155)
+            CALL correct (  70,155, 72,155)
+            CALL correct (  71,155, 72,155)
+            CALL correct (  73,155, 75,155)
+            CALL correct (  74,155, 75,155)
+            CALL correct (  76,155, 78,155)
+            CALL correct (  77,155, 78,155)
+            CALL correct (  80,155, 81,155)
+            CALL correct (  90,155, 91,155)
+            CALL correct (  92,155, 93,155)
+            CALL correct (  95,155, 96,155)
+            CALL correct (  98,155, 99,155)
+            CALL correct ( 101,155,102,155)
+            CALL correct ( 104,155,105,155)
+            CALL correct ( 107,155,108,155)
+            CALL correct ( 109,155,110,155)
+            CALL correct ( 112,155,113,155)
+            CALL correct ( 114,155,116,155)
+            CALL correct ( 115,155,116,155)
+            CALL correct ( 117,155,118,155)
+            CALL correct ( 119,155,120,155)
+            CALL correct ( 122,155,123,155)
+            CALL correct ( 125,155,126,155)
+            CALL correct ( 128,155,129,155)
+            CALL correct ( 131,155,132,155)
+            CALL correct ( 134,155,135,155)
+            CALL correct ( 136,155,137,155)
+            CALL correct ( 139,155,140,155)
+            CALL correct ( 142,155,143,155)
+            CALL correct ( 146,155,147,155)
+            CALL correct ( 149,155,151,155)
+            CALL correct ( 150,155,151,155)
+            CALL correct ( 152,155,154,155)
+            CALL correct ( 153,155,154,155)
+            CALL correct ( 155,155,157,155)
+            CALL correct ( 156,155,157,155)
+            CALL correct ( 158,155,160,155)
+            CALL correct ( 159,155,160,155)
+            CALL correct ( 162,155,164,155)
+            CALL correct ( 163,155,164,155)
+            CALL correct ( 166,155,167,155)
+            CALL correct ( 169,155,170,155)
+            CALL correct ( 172,155,173,155)
+            CALL correct ( 174,155,175,155)
+            CALL correct ( 177,155,178,155)
+            CALL correct ( 180,155,181,155)
+            CALL correct ( 184,155,185,155)
+            CALL correct ( 189,155,190,155)
+            CALL correct ( 191,155,192,155)
+            CALL correct ( 193,155,194,155)
+            CALL correct ( 195,155,197,155)
+            CALL correct ( 196,155,197,155)
+            CALL correct ( 198,155,199,155)
+            CALL correct ( 200,155,201,155)
+            CALL correct ( 210,155,211,155)
+            CALL correct ( 228,155,229,155)
+            CALL correct ( 231,155,232,155)
+            CALL correct ( 233,155,235,155)
+            CALL correct ( 234,155,235,155)
+            CALL correct ( 236,155,237,155)
+            CALL correct ( 239,155,240,155)
+            CALL correct ( 250,155,251,155)
+            CALL correct ( 253,155,254,155)
+            CALL correct ( 260,155,261,155)
+            CALL correct ( 262,155,263,155)
+            CALL correct ( 264,155,265,155)
+            CALL correct ( 269,155,270,155)
+            CALL correct ( 271,155,272,155)
+            CALL correct ( 273,155,274,155)
+            CALL correct ( 276,155,277,155)
+            CALL correct ( 280,155,281,155)
+            CALL correct ( 283,155,284,155)
+            CALL correct ( 286,155,285,155)
+            CALL correct ( 292,155,294,155)
+            CALL correct ( 295,155,296,155)
+            CALL correct ( 302,155,303,155)
+            CALL correct ( 305,155,307,155)
+            CALL correct ( 306,155,307,155)
+            CALL correct ( 308,155,310,155)
+            CALL correct ( 309,155,310,155)
+            CALL correct ( 311,155,313,155)
+            CALL correct ( 312,155,313,155)
+            CALL correct ( 315,155,316,155)
+            CALL correct ( 318,155,319,155)
+            CALL correct (   1,156,  2,156)
+            CALL correct (   4,156,  2,156)
+            CALL correct (   5,156,  2,156)
+            CALL correct (   8,156,  2,156)
+            CALL correct (  10,156, 14,156)
+            CALL correct (  12,156, 14,156)
+            CALL correct (  15,156, 14,156)
+            CALL correct (  17,156, 14,156)
+            CALL correct (  21,156, 26,156)
+            CALL correct (  24,156, 26,156)
+            CALL correct (  25,156, 26,156)
+            CALL correct (  27,156, 26,156)
+            CALL correct (  30,156, 35,156)
+            CALL correct (  33,156, 35,156)
+            CALL correct (  36,156, 35,156)
+            CALL correct (  38,156, 35,156)
+            CALL correct (  39,156, 35,156)
+            CALL correct (  42,156, 45,156)
+            CALL correct (  44,156, 45,156)
+            CALL correct (  46,156, 45,156)
+            CALL correct (  48,156, 45,156)
+            CALL correct (  50,156, 55,156)
+            CALL correct (  53,156, 55,156)
+            CALL correct (  58,156, 55,156)
+            CALL correct (  59,156, 55,156)
+            CALL correct (  62,156, 65,156)
+            CALL correct (  63,156, 65,156)
+            CALL correct (  66,156, 65,156)
+            CALL correct (  67,156, 65,156)
+            CALL correct (  70,156, 76,156)
+            CALL correct (  71,156, 76,156)
+            CALL correct (  73,156, 76,156)
+            CALL correct (  74,156, 76,156)
+            CALL correct (  75,156, 76,156)
+            CALL correct (  77,156, 76,156)
+            CALL correct (  78,156, 76,156)
+            CALL correct (  81,156, 84,156)
+            CALL correct (  82,156, 84,156)
+            CALL correct (  85,156, 84,156)
+            CALL correct (  86,156, 84,156)
+            CALL correct (  90,156, 96,156)
+            CALL correct (  94,156, 96,156)
+            CALL correct (  95,156, 96,156)
+            CALL correct (  98,156, 96,156)
+            CALL correct ( 100,156,104,156)
+            CALL correct ( 102,156,104,156)
+            CALL correct ( 105,156,104,156)
+            CALL correct ( 106,156,104,156)
+            CALL correct ( 111,156,113,156)
+            CALL correct ( 112,156,113,156)
+            CALL correct ( 114,156,113,156)
+            CALL correct ( 115,156,113,156)
+            CALL correct ( 117,156,113,156)
+            CALL correct ( 118,156,113,156)
+            CALL correct ( 120,156,126,156)
+            CALL correct ( 123,156,126,156)
+            CALL correct ( 125,156,126,156)
+            CALL correct ( 129,156,126,156)
+            CALL correct ( 131,156,135,156)
+            CALL correct ( 133,156,135,156)
+            CALL correct ( 138,156,135,156)
+            CALL correct ( 140,156,145,156)
+            CALL correct ( 143,156,145,156)
+            CALL correct ( 144,156,145,156)
+            CALL correct ( 147,156,145,156)
+            CALL correct ( 148,156,145,156)
+            CALL correct ( 149,156,145,156)
+            CALL correct ( 151,156,154,156)
+            CALL correct ( 152,156,154,156)
+            CALL correct ( 153,156,154,156)
+            CALL correct ( 155,156,154,156)
+            CALL correct ( 156,156,154,156)
+            CALL correct ( 157,156,154,156)
+            CALL correct ( 159,156,154,156)
+            CALL correct ( 160,156,165,156)
+            CALL correct ( 163,156,165,156)
+            CALL correct ( 164,156,165,156)
+            CALL correct ( 167,156,165,156)
+            CALL correct ( 168,156,165,156)
+            CALL correct ( 171,156,176,156)
+            CALL correct ( 172,156,176,156)
+            CALL correct ( 175,156,176,156)
+            CALL correct ( 177,156,176,156)
+            CALL correct ( 180,156,185,156)
+            CALL correct ( 182,156,185,156)
+            CALL correct ( 187,156,185,156)
+            CALL correct ( 188,156,185,156)
+            CALL correct ( 190,156,191,156)
+            CALL correct ( 193,156,192,156)
+            CALL correct ( 195,156,194,156)
+            CALL correct ( 196,156,197,156)
+            CALL correct ( 198,156,199,156)
+            CALL correct ( 201,156,205,156)
+            CALL correct ( 206,156,205,156)
+            CALL correct ( 208,156,205,156)
+            CALL correct ( 210,156,215,156)
+            CALL correct ( 213,156,215,156)
+            CALL correct ( 216,156,215,156)
+            CALL correct ( 218,156,215,156)
+            CALL correct ( 224,156,225,156)
+            CALL correct ( 227,156,225,156)
+            CALL correct ( 230,156,235,156)
+            CALL correct ( 231,156,235,156)
+            CALL correct ( 233,156,235,156)
+            CALL correct ( 234,156,235,156)
+            CALL correct ( 237,156,235,156)
+            CALL correct ( 240,156,245,156)
+            CALL correct ( 244,156,245,156)
+            CALL correct ( 248,156,245,156)
+            CALL correct ( 251,156,255,156)
+            CALL correct ( 253,156,255,156)
+            CALL correct ( 256,156,255,156)
+            CALL correct ( 258,156,255,156)
+            CALL correct ( 263,156,265,156)
+            CALL correct ( 266,156,265,156)
+            CALL correct ( 268,156,265,156)
+            CALL correct ( 269,156,265,156)
+            CALL correct ( 271,156,275,156)
+            CALL correct ( 272,156,275,156)
+            CALL correct ( 274,156,275,156)
+            CALL correct ( 277,156,275,156)
+            CALL correct ( 282,156,285,156)
+            CALL correct ( 284,156,285,156)
+            CALL correct ( 286,156,285,156)
+            CALL correct ( 291,156,295,156)
+            CALL correct ( 293,156,295,156)
+            CALL correct ( 296,156,295,156)
+            CALL correct ( 297,156,295,156)
+            CALL correct ( 300,156,306,156)
+            CALL correct ( 301,156,306,156)
+            CALL correct ( 304,156,306,156)
+            CALL correct ( 305,156,306,156)
+            CALL correct ( 308,156,306,156)
+            CALL correct ( 309,156,306,156)
+            CALL correct ( 311,156,315,156)
+            CALL correct ( 312,156,315,156)
+            CALL correct ( 313,156,315,156)
+            CALL correct ( 316,156,315,156)
+            CALL correct ( 317,156,315,156)
+            CALL correct ( 320,156,315,156)
+            CALL correct (   3,157,  6,157)
+            CALL correct (   5,157,  6,157)
+            CALL correct (   8,157,  6,157)
+            CALL correct (   9,157,  6,157)
+            CALL correct (  11,157, 15,157)
+            CALL correct (  13,157, 15,157)
+            CALL correct (  14,157, 15,157)
+            CALL correct (  16,157, 15,157)
+            CALL correct (  18,157, 15,157)
+            CALL correct (  19,157, 15,157)
+            CALL correct (  22,157, 25,157)
+            CALL correct (  23,157, 25,157)
+            CALL correct (  26,157, 25,157)
+            CALL correct (  27,157, 25,157)
+            CALL correct (  29,157, 25,157)
+            CALL correct (  30,157, 35,157)
+            CALL correct (  31,157, 35,157)
+            CALL correct (  33,157, 35,157)
+            CALL correct (  34,157, 35,157)
+            CALL correct (  37,157, 35,157)
+            CALL correct (  39,157, 35,157)
+            CALL correct (  41,157, 44,157)
+            CALL correct (  43,157, 44,157)
+            CALL correct (  45,157, 44,157)
+            CALL correct (  46,157, 44,157)
+            CALL correct (  48,157, 44,157)
+            CALL correct (  50,157, 56,157)
+            CALL correct (  52,157, 56,157)
+            CALL correct (  54,157, 56,157)
+            CALL correct (  55,157, 56,157)
+            CALL correct (  57,157, 56,157)
+            CALL correct (  60,157, 63,157)
+            CALL correct (  62,157, 63,157)
+            CALL correct (  64,157, 63,157)
+            CALL correct (  65,157, 63,157)
+            CALL correct (  66,157, 63,157)
+            CALL correct (  69,157, 63,157)
+            CALL correct (  70,157, 76,157)
+            CALL correct (  71,157, 76,157)
+            CALL correct (  73,157, 76,157)
+            CALL correct (  74,157, 76,157)
+            CALL correct (  75,157, 76,157)
+            CALL correct (  78,157, 76,157)
+            CALL correct (  79,157, 76,157)
+            CALL correct (  80,157, 85,157)
+            CALL correct (  84,157, 85,157)
+            CALL correct (  87,157, 85,157)
+            CALL correct (  89,157, 85,157)
+            CALL correct (  90,157, 95,157)
+            CALL correct (  92,157, 95,157)
+            CALL correct (  94,157, 95,157)
+            CALL correct (  96,157, 95,157)
+            CALL correct (  97,157, 95,157)
+            CALL correct (  99,157, 95,157)
+            CALL correct ( 101,157,105,157)
+            CALL correct ( 103,157,105,157)
+            CALL correct ( 104,157,105,157)
+            CALL correct ( 107,157,105,157)
+            CALL correct ( 110,157,116,157)
+            CALL correct ( 111,157,116,157)
+            CALL correct ( 113,157,116,157)
+            CALL correct ( 114,157,116,157)
+            CALL correct ( 115,157,116,157)
+            CALL correct ( 117,157,116,157)
+            CALL correct ( 118,157,116,157)
+            CALL correct ( 121,157,127,157)
+            CALL correct ( 122,157,127,157)
+            CALL correct ( 125,157,127,157)
+            CALL correct ( 126,157,127,157)
+            CALL correct ( 128,157,127,157)
+            CALL correct ( 129,157,127,157)
+            CALL correct ( 131,157,137,157)
+            CALL correct ( 133,157,137,157)
+            CALL correct ( 135,157,137,157)
+            CALL correct ( 136,157,137,157)
+            CALL correct ( 138,157,137,157)
+            CALL correct ( 141,157,144,157)
+            CALL correct ( 145,157,144,157)
+            CALL correct ( 146,157,144,157)
+            CALL correct ( 147,157,144,157)
+            CALL correct ( 150,157,154,157)
+            CALL correct ( 151,157,154,157)
+            CALL correct ( 152,157,154,157)
+            CALL correct ( 153,157,154,157)
+            CALL correct ( 155,157,154,157)
+            CALL correct ( 156,157,154,157)
+            CALL correct ( 157,157,154,157)
+            CALL correct ( 160,157,165,157)
+            CALL correct ( 161,157,165,157)
+            CALL correct ( 162,157,165,157)
+            CALL correct ( 166,157,165,157)
+            CALL correct ( 168,157,165,157)
+            CALL correct ( 171,157,175,157)
+            CALL correct ( 174,157,175,157)
+            CALL correct ( 176,157,175,157)
+            CALL correct ( 177,157,175,157)
+            CALL correct ( 179,157,175,157)
+            CALL correct ( 181,157,184,157)
+            CALL correct ( 185,157,184,157)
+            CALL correct ( 186,157,184,157)
+            CALL correct ( 189,157,184,157)
+            CALL correct ( 192,157,194,157)
+            CALL correct ( 193,157,194,157)
+            CALL correct ( 195,157,194,157)
+            CALL correct ( 196,157,194,157)
+            CALL correct ( 197,157,194,157)
+            CALL correct ( 199,157,194,157)
+            CALL correct ( 200,157,204,157)
+            CALL correct ( 203,157,204,157)
+            CALL correct ( 205,157,204,157)
+            CALL correct ( 209,157,204,157)
+            CALL correct ( 210,157,215,157)
+            CALL correct ( 212,157,215,157)
+            CALL correct ( 214,157,215,157)
+            CALL correct ( 218,157,215,157)
+            CALL correct ( 221,157,224,157)
+            CALL correct ( 225,157,224,157)
+            CALL correct ( 226,157,224,157)
+            CALL correct ( 229,157,224,157)
+            CALL correct ( 230,157,236,157)
+            CALL correct ( 231,157,236,157)
+            CALL correct ( 233,157,236,157)
+            CALL correct ( 234,157,236,157)
+            CALL correct ( 235,157,236,157)
+            CALL correct ( 238,157,236,157)
+            CALL correct ( 239,157,236,157)
+            CALL correct ( 243,157,245,157)
+            CALL correct ( 246,157,245,157)
+            CALL correct ( 249,157,245,157)
+            CALL correct ( 252,157,254,157)
+            CALL correct ( 253,157,254,157)
+            CALL correct ( 255,157,254,157)
+            CALL correct ( 259,157,254,157)
+            CALL correct ( 261,157,264,157)
+            CALL correct ( 262,157,264,157)
+            CALL correct ( 265,157,264,157)
+            CALL correct ( 267,157,264,157)
+            CALL correct ( 268,157,264,157)
+            CALL correct ( 269,157,264,157)
+            CALL correct ( 271,157,274,157)
+            CALL correct ( 272,157,274,157)
+            CALL correct ( 275,157,274,157)
+            CALL correct ( 278,157,274,157)
+            CALL correct ( 279,157,274,157)
+            CALL correct ( 281,157,284,157)
+            CALL correct ( 285,157,284,157)
+            CALL correct ( 286,157,284,157)
+            CALL correct ( 288,157,284,157)
+            CALL correct ( 290,157,295,157)
+            CALL correct ( 292,157,295,157)
+            CALL correct ( 296,157,295,157)
+            CALL correct ( 298,157,295,157)
+            CALL correct ( 302,157,305,157)
+            CALL correct ( 303,157,305,157)
+            CALL correct ( 304,157,305,157)
+            CALL correct ( 307,157,305,157)
+            CALL correct ( 308,157,305,157)
+            CALL correct ( 309,157,305,157)
+            CALL correct ( 310,157,315,157)
+            CALL correct ( 312,157,315,157)
+            CALL correct ( 313,157,315,157)
+            CALL correct ( 314,157,315,157)
+            CALL correct ( 317,157,315,157)
+            CALL correct ( 318,157,315,157)
+            CALL correct ( 319,157,315,157)
+            CALL correct (   1,158,  4,158)
+            CALL correct (   2,158,  4,158)
+            CALL correct (   3,158,  4,158)
+            CALL correct (   5,158,  4,158)
+            CALL correct (   7,158,  4,158)
+            CALL correct (   8,158,  4,158)
+            CALL correct (   9,158,  4,158)
+            CALL correct (  11,158, 15,158)
+            CALL correct (  13,158, 15,158)
+            CALL correct (  14,158, 15,158)
+            CALL correct (  16,158, 15,158)
+            CALL correct (  17,158, 15,158)
+            CALL correct (  19,158, 15,158)
+            CALL correct (  20,158, 23,158)
+            CALL correct (  21,158, 23,158)
+            CALL correct (  24,158, 23,158)
+            CALL correct (  25,158, 23,158)
+            CALL correct (  26,158, 23,158)
+            CALL correct (  29,158, 23,158)
+            CALL correct (  30,158, 33,158)
+            CALL correct (  31,158, 33,158)
+            CALL correct (  34,158, 33,158)
+            CALL correct (  35,158, 33,158)
+            CALL correct (  36,158, 33,158)
+            CALL correct (  39,158, 33,158)
+            CALL correct (  40,158, 43,158)
+            CALL correct (  42,158, 43,158)
+            CALL correct (  44,158, 43,158)
+            CALL correct (  45,158, 43,158)
+            CALL correct (  47,158, 43,158)
+            CALL correct (  48,158, 43,158)
+            CALL correct (  50,158, 54,158)
+            CALL correct (  51,158, 54,158)
+            CALL correct (  53,158, 54,158)
+            CALL correct (  55,158, 54,158)
+            CALL correct (  57,158, 54,158)
+            CALL correct (  58,158, 54,158)
+            CALL correct (  61,158, 65,158)
+            CALL correct (  62,158, 65,158)
+            CALL correct (  63,158, 65,158)
+            CALL correct (  64,158, 65,158)
+            CALL correct (  67,158, 65,158)
+            CALL correct (  68,158, 65,158)
+            CALL correct (  69,158, 65,158)
+            CALL correct (  70,158, 72,158)
+            CALL correct (  71,158, 72,158)
+            CALL correct (  73,158, 72,158)
+            CALL correct (  74,158, 72,158)
+            CALL correct (  75,158, 72,158)
+            CALL correct (  76,158, 72,158)
+            CALL correct (  77,158, 72,158)
+            CALL correct (  80,158, 84,158)
+            CALL correct (  81,158, 84,158)
+            CALL correct (  82,158, 84,158)
+            CALL correct (  83,158, 84,158)
+            CALL correct (  85,158, 84,158)
+            CALL correct (  87,158, 84,158)
+            CALL correct (  89,158, 84,158)
+            CALL correct (  91,158, 95,158)
+            CALL correct (  93,158, 95,158)
+            CALL correct (  94,158, 95,158)
+            CALL correct (  96,158, 95,158)
+            CALL correct (  97,158, 95,158)
+            CALL correct (  99,158, 95,158)
+            CALL correct ( 100,158,103,158)
+            CALL correct ( 102,158,103,158)
+            CALL correct ( 104,158,103,158)
+            CALL correct ( 105,158,103,158)
+            CALL correct ( 108,158,103,158)
+            CALL correct ( 109,158,103,158)
+            CALL correct ( 110,158,112,158)
+            CALL correct ( 111,158,112,158)
+            CALL correct ( 113,158,112,158)
+            CALL correct ( 114,158,112,158)
+            CALL correct ( 115,158,112,158)
+            CALL correct ( 116,158,112,158)
+            CALL correct ( 118,158,112,158)
+            CALL correct ( 119,158,112,158)
+            CALL correct ( 120,158,122,158)
+            CALL correct ( 123,158,122,158)
+            CALL correct ( 124,158,122,158)
+            CALL correct ( 125,158,122,158)
+            CALL correct ( 127,158,122,158)
+            CALL correct ( 128,158,122,158)
+            CALL correct ( 130,158,135,158)
+            CALL correct ( 131,158,135,158)
+            CALL correct ( 133,158,135,158)
+            CALL correct ( 134,158,135,158)
+            CALL correct ( 136,158,135,158)
+            CALL correct ( 137,158,135,158)
+            CALL correct ( 138,158,135,158)
+            CALL correct ( 140,158,147,158)
+            CALL correct ( 142,158,147,158)
+            CALL correct ( 143,158,147,158)
+            CALL correct ( 144,158,147,158)
+            CALL correct ( 145,158,147,158)
+            CALL correct ( 148,158,147,158)
+            CALL correct ( 149,158,147,158)
+            CALL correct ( 150,158,154,158)
+            CALL correct ( 151,158,154,158)
+            CALL correct ( 152,158,154,158)
+            CALL correct ( 155,158,154,158)
+            CALL correct ( 156,158,154,158)
+            CALL correct ( 157,158,154,158)
+            CALL correct ( 158,158,154,158)
+            CALL correct ( 162,158,168,158)
+            CALL correct ( 163,158,168,158)
+            CALL correct ( 164,158,168,158)
+            CALL correct ( 165,158,168,158)
+            CALL correct ( 167,158,168,158)
+            CALL correct ( 169,158,168,158)
+            CALL correct ( 170,158,175,158)
+            CALL correct ( 171,158,175,158)
+            CALL correct ( 173,158,175,158)
+            CALL correct ( 174,158,175,158)
+            CALL correct ( 176,158,175,158)
+            CALL correct ( 177,158,175,158)
+            CALL correct ( 179,158,175,158)
+            CALL correct ( 180,158,184,158)
+            CALL correct ( 182,158,184,158)
+            CALL correct ( 183,158,184,158)
+            CALL correct ( 185,158,184,158)
+            CALL correct ( 187,158,184,158)
+            CALL correct ( 188,158,184,158)
+            CALL correct ( 191,158,194,158)
+            CALL correct ( 192,158,194,158)
+            CALL correct ( 193,158,194,158)
+            CALL correct ( 195,158,194,158)
+            CALL correct ( 196,158,194,158)
+            CALL correct ( 197,158,194,158)
+            CALL correct ( 198,158,194,158)
+            CALL correct ( 201,158,204,158)
+            CALL correct ( 202,158,204,158)
+            CALL correct ( 205,158,204,158)
+            CALL correct ( 206,158,204,158)
+            CALL correct ( 207,158,204,158)
+            CALL correct ( 209,158,204,158)
+            CALL correct ( 210,158,213,158)
+            CALL correct ( 212,158,213,158)
+            CALL correct ( 214,158,213,158)
+            CALL correct ( 215,158,213,158)
+            CALL correct ( 218,158,213,158)
+            CALL correct ( 220,158,221,158)
+            CALL correct ( 222,158,221,158)
+            CALL correct ( 223,158,221,158)
+            CALL correct ( 224,158,221,158)
+            CALL correct ( 225,158,221,158)
+            CALL correct ( 228,158,221,158)
+            CALL correct ( 229,158,221,158)
+            CALL correct ( 230,158,232,158)
+            CALL correct ( 231,158,232,158)
+            CALL correct ( 233,158,232,158)
+            CALL correct ( 234,158,232,158)
+            CALL correct ( 235,158,232,158)
+            CALL correct ( 236,158,232,158)
+            CALL correct ( 237,158,232,158)
+            CALL correct ( 239,158,232,158)
+            CALL correct ( 240,158,243,158)
+            CALL correct ( 241,158,243,158)
+            CALL correct ( 242,158,243,158)
+            CALL correct ( 244,158,243,158)
+            CALL correct ( 246,158,243,158)
+            CALL correct ( 248,158,243,158)
+            CALL correct ( 250,158,254,158)
+            CALL correct ( 252,158,254,158)
+            CALL correct ( 253,158,254,158)
+            CALL correct ( 255,158,254,158)
+            CALL correct ( 257,158,254,158)
+            CALL correct ( 258,158,254,158)
+            CALL correct ( 259,158,254,158)
+            CALL correct ( 262,158,265,158)
+            CALL correct ( 263,158,265,158)
+            CALL correct ( 266,158,265,158)
+            CALL correct ( 267,158,265,158)
+            CALL correct ( 268,158,265,158)
+            CALL correct ( 269,158,265,158)
+            CALL correct ( 271,158,275,158)
+            CALL correct ( 272,158,275,158)
+            CALL correct ( 273,158,275,158)
+            CALL correct ( 276,158,275,158)
+            CALL correct ( 277,158,275,158)
+            CALL correct ( 279,158,275,158)
+            CALL correct ( 281,158,284,158)
+            CALL correct ( 282,158,284,158)
+            CALL correct ( 283,158,284,158)
+            CALL correct ( 285,158,284,158)
+            CALL correct ( 288,158,284,158)
+            CALL correct ( 289,158,284,158)
+            CALL correct ( 291,158,292,158)
+            CALL correct ( 293,158,292,158)
+            CALL correct ( 294,158,292,158)
+            CALL correct ( 295,158,292,158)
+            CALL correct ( 297,158,292,158)
+            CALL correct ( 299,158,292,158)
+            CALL correct ( 300,158,305,158)
+            CALL correct ( 301,158,305,158)
+            CALL correct ( 302,158,305,158)
+            CALL correct ( 306,158,305,158)
+            CALL correct ( 307,158,305,158)
+            CALL correct ( 308,158,305,158)
+            CALL correct ( 309,158,305,158)
+            CALL correct ( 310,158,317,158)
+            CALL correct ( 312,158,317,158)
+            CALL correct ( 313,158,317,158)
+            CALL correct ( 314,158,317,158)
+            CALL correct ( 315,158,317,158)
+            CALL correct ( 316,158,317,158)
+            CALL correct ( 319,158,317,158)
+            CALL correct ( 320,158,317,158)
+
+            CALL correct (   2,159,  1,159)
+            CALL correct (   3,159,  1,159)
+            CALL correct (   5,159,  1,159)
+            CALL correct (   6,159,  1,159)
+            CALL correct (   7,159,  1,159)
+            CALL correct (   9,159,  1,159)
+            CALL correct (  10,159, 11,159)
+            CALL correct (  12,159, 11,159)
+            CALL correct (  13,159, 11,159)
+            CALL correct (  14,159, 11,159)
+            CALL correct (  15,159, 11,159)
+            CALL correct (  17,159, 11,159)
+            CALL correct (  18,159, 11,159)
+            CALL correct (  19,159, 11,159)
+            CALL correct (  21,159, 25,159)
+            CALL correct (  22,159, 25,159)
+            CALL correct (  23,159, 25,159)
+            CALL correct (  24,159, 25,159)
+            CALL correct (  26,159, 25,159)
+            CALL correct (  27,159, 25,159)
+            CALL correct (  28,159, 25,159)
+            CALL correct (  29,159, 25,159)
+            CALL correct (  30,159, 33,159)
+            CALL correct (  31,159, 33,159)
+            CALL correct (  32,159, 33,159)
+            CALL correct (  34,159, 33,159)
+            CALL correct (  35,159, 33,159)
+            CALL correct (  36,159, 33,159)
+            CALL correct (  37,159, 33,159)
+            CALL correct (  38,159, 33,159)
+            CALL correct (  39,159, 33,159)
+            CALL correct (  41,159, 45,159)
+            CALL correct (  42,159, 45,159)
+            CALL correct (  44,159, 45,159)
+            CALL correct (  46,159, 45,159)
+            CALL correct (  47,159, 45,159)
+            CALL correct (  48,159, 45,159)
+            CALL correct (  50,159, 54,159)
+            CALL correct (  51,159, 54,159)
+            CALL correct (  52,159, 54,159)
+            CALL correct (  53,159, 54,159)
+            CALL correct (  55,159, 54,159)
+            CALL correct (  56,159, 54,159)
+            CALL correct (  57,159, 54,159)
+            CALL correct (  58,159, 54,159)
+            CALL correct (  59,159, 54,159)
+            CALL correct (  61,159, 64,159)
+            CALL correct (  62,159, 64,159)
+            CALL correct (  65,159, 64,159)
+            CALL correct (  66,159, 64,159)
+            CALL correct (  67,159, 64,159)
+            CALL correct (  68,159, 64,159)
+            CALL correct (  69,159, 64,159)
+            CALL correct (  70,159, 72,159)
+            CALL correct (  71,159, 72,159)
+            CALL correct (  73,159, 72,159)
+            CALL correct (  74,159, 72,159)
+            CALL correct (  75,159, 72,159)
+            CALL correct (  76,159, 72,159)
+            CALL correct (  77,159, 72,159)
+            CALL correct (  78,159, 72,159)
+            CALL correct (  79,159, 72,159)
+            CALL correct (  81,159, 84,159)
+            CALL correct (  83,159, 84,159)
+            CALL correct (  85,159, 84,159)
+            CALL correct (  86,159, 84,159)
+            CALL correct (  87,159, 84,159)
+            CALL correct (  88,159, 84,159)
+            CALL correct (  89,159, 84,159)
+            CALL correct (  90,159, 95,159)
+            CALL correct (  92,159, 95,159)
+            CALL correct (  93,159, 95,159)
+            CALL correct (  94,159, 95,159)
+            CALL correct (  96,159, 95,159)
+            CALL correct (  97,159, 95,159)
+            CALL correct (  98,159, 95,159)
+            CALL correct ( 100,159,104,159)
+            CALL correct ( 102,159,104,159)
+            CALL correct ( 103,159,104,159)
+            CALL correct ( 105,159,104,159)
+            CALL correct ( 106,159,104,159)
+            CALL correct ( 107,159,104,159)
+            CALL correct ( 108,159,104,159)
+            CALL correct ( 109,159,104,159)
+            CALL correct ( 110,159,111,159)
+            CALL correct ( 112,159,111,159)
+            CALL correct ( 113,159,111,159)
+            CALL correct ( 114,159,111,159)
+            CALL correct ( 115,159,111,159)
+            CALL correct ( 116,159,111,159)
+            CALL correct ( 117,159,111,159)
+            CALL correct ( 118,159,111,159)
+            CALL correct ( 120,159,124,159)
+            CALL correct ( 121,159,124,159)
+            CALL correct ( 122,159,124,159)
+            CALL correct ( 123,159,124,159)
+            CALL correct ( 125,159,124,159)
+            CALL correct ( 126,159,124,159)
+            CALL correct ( 127,159,124,159)
+            CALL correct ( 129,159,124,159)
+            CALL correct ( 130,159,133,159)
+            CALL correct ( 131,159,133,159)
+            CALL correct ( 132,159,133,159)
+            CALL correct ( 134,159,133,159)
+            CALL correct ( 135,159,133,159)
+            CALL correct ( 137,159,133,159)
+            CALL correct ( 138,159,133,159)
+            CALL correct ( 139,159,133,159)
+            CALL correct ( 141,159,143,159)
+            CALL correct ( 142,159,143,159)
+            CALL correct ( 144,159,143,159)
+            CALL correct ( 146,159,143,159)
+            CALL correct ( 147,159,143,159)
+            CALL correct ( 148,159,143,159)
+            CALL correct ( 149,159,143,159)
+            CALL correct ( 150,159,153,159)
+            CALL correct ( 151,159,153,159)
+            CALL correct ( 152,159,153,159)
+            CALL correct ( 154,159,153,159)
+            CALL correct ( 155,159,153,159)
+            CALL correct ( 156,159,153,159)
+            CALL correct ( 157,159,153,159)
+            CALL correct ( 158,159,153,159)
+            CALL correct ( 159,159,153,159)
+            CALL correct ( 160,159,164,159)
+            CALL correct ( 161,159,164,159)
+            CALL correct ( 163,159,164,159)
+            CALL correct ( 165,159,164,159)
+            CALL correct ( 166,159,164,159)
+            CALL correct ( 168,159,164,159)
+            CALL correct ( 169,159,164,159)
+            CALL correct ( 171,159,174,159)
+            CALL correct ( 172,159,174,159)
+            CALL correct ( 173,159,174,159)
+            CALL correct ( 175,159,174,159)
+            CALL correct ( 176,159,174,159)
+            CALL correct ( 177,159,174,159)
+            CALL correct ( 179,159,174,159)
+            CALL correct ( 180,159,185,159)
+            CALL correct ( 181,159,185,159)
+            CALL correct ( 183,159,185,159)
+            CALL correct ( 184,159,185,159)
+            CALL correct ( 186,159,185,159)
+            CALL correct ( 188,159,185,159)
+            CALL correct ( 189,159,185,159)
+            CALL correct ( 190,159,195,159)
+            CALL correct ( 191,159,195,159)
+            CALL correct ( 192,159,195,159)
+            CALL correct ( 193,159,195,159)
+            CALL correct ( 194,159,195,159)
+            CALL correct ( 196,159,195,159)
+            CALL correct ( 197,159,195,159)
+            CALL correct ( 198,159,195,159)
+            CALL correct ( 199,159,195,159)
+            CALL correct ( 200,159,205,159)
+            CALL correct ( 201,159,205,159)
+            CALL correct ( 203,159,205,159)
+            CALL correct ( 204,159,205,159)
+            CALL correct ( 206,159,205,159)
+            CALL correct ( 208,159,205,159)
+            CALL correct ( 209,159,205,159)
+            CALL correct ( 210,159,215,159)
+            CALL correct ( 212,159,215,159)
+            CALL correct ( 213,159,215,159)
+            CALL correct ( 214,159,215,159)
+            CALL correct ( 216,159,215,159)
+            CALL correct ( 217,159,215,159)
+            CALL correct ( 218,159,215,159)
+            CALL correct ( 219,159,215,159)
+            CALL correct ( 220,159,225,159)
+            CALL correct ( 222,159,225,159)
+            CALL correct ( 224,159,225,159)
+            CALL correct ( 226,159,225,159)
+            CALL correct ( 227,159,225,159)
+            CALL correct ( 228,159,225,159)
+            CALL correct ( 229,159,225,159)
+            CALL correct ( 230,159,232,159)
+            CALL correct ( 231,159,232,159)
+            CALL correct ( 233,159,232,159)
+            CALL correct ( 234,159,232,159)
+            CALL correct ( 235,159,232,159)
+            CALL correct ( 236,159,232,159)
+            CALL correct ( 237,159,232,159)
+            CALL correct ( 238,159,232,159)
+            CALL correct ( 239,159,232,159)
+            CALL correct ( 242,159,243,159)
+            CALL correct ( 244,159,243,159)
+            CALL correct ( 245,159,243,159)
+            CALL correct ( 246,159,243,159)
+            CALL correct ( 247,159,243,159)
+            CALL correct ( 248,159,243,159)
+            CALL correct ( 249,159,243,159)
+            CALL correct ( 251,159,254,159)
+            CALL correct ( 252,159,254,159)
+            CALL correct ( 253,159,254,159)
+            CALL correct ( 255,159,254,159)
+            CALL correct ( 256,159,254,159)
+            CALL correct ( 258,159,254,159)
+            CALL correct ( 259,159,254,159)
+            CALL correct ( 261,159,262,159)
+            CALL correct ( 263,159,262,159)
+            CALL correct ( 264,159,262,159)
+            CALL correct ( 265,159,262,159)
+            CALL correct ( 266,159,262,159)
+            CALL correct ( 267,159,262,159)
+            CALL correct ( 268,159,262,159)
+            CALL correct ( 271,159,277,159)
+            CALL correct ( 272,159,277,159)
+            CALL correct ( 273,159,277,159)
+            CALL correct ( 274,159,277,159)
+            CALL correct ( 275,159,277,159)
+            CALL correct ( 276,159,277,159)
+            CALL correct ( 278,159,277,159)
+            CALL correct ( 280,159,282,159)
+            CALL correct ( 281,159,282,159)
+            CALL correct ( 283,159,282,159)
+            CALL correct ( 284,159,282,159)
+            CALL correct ( 285,159,282,159)
+            CALL correct ( 287,159,282,159)
+            CALL correct ( 288,159,282,159)
+            CALL correct ( 289,159,282,159)
+            CALL correct ( 290,159,294,159)
+            CALL correct ( 292,159,294,159)
+            CALL correct ( 293,159,294,159)
+            CALL correct ( 295,159,294,159)
+            CALL correct ( 296,159,294,159)
+            CALL correct ( 297,159,294,159)
+            CALL correct ( 299,159,294,159)
+            CALL correct ( 301,159,302,159)
+            CALL correct ( 303,159,302,159)
+            CALL correct ( 304,159,302,159)
+            CALL correct ( 305,159,302,159)
+            CALL correct ( 306,159,302,159)
+            CALL correct ( 307,159,302,159)
+            CALL correct ( 308,159,302,159)
+            CALL correct ( 309,159,302,159)
+            CALL correct ( 310,159,311,159)
+            CALL correct ( 312,159,311,159)
+            CALL correct ( 313,159,311,159)
+            CALL correct ( 314,159,311,159)
+            CALL correct ( 315,159,311,159)
+            CALL correct ( 316,159,311,159)
+            CALL correct ( 317,159,311,159)
+            CALL correct ( 318,159,311,159)
+            CALL correct ( 319,159,311,159)
+
+            CALL correct (   1,160,  8,160)
+            CALL correct (   2,160,  8,160)
+            CALL correct (   3,160,  8,160)
+            CALL correct (   4,160,  8,160)
+            CALL correct (   5,160,  8,160)
+            CALL correct (   6,160,  8,160)
+            CALL correct (   7,160,  8,160)
+            CALL correct (   9,160,  8,160)
+            CALL correct (  10,160, 16,160)
+            CALL correct (  11,160, 16,160)
+            CALL correct (  12,160, 16,160)
+            CALL correct (  13,160, 16,160)
+            CALL correct (  14,160, 16,160)
+            CALL correct (  15,160, 16,160)
+            CALL correct (  17,160, 16,160)
+            CALL correct (  18,160, 16,160)
+            CALL correct (  19,160, 16,160)
+            CALL correct (  20,160, 23,160)
+            CALL correct (  21,160, 23,160)
+            CALL correct (  22,160, 23,160)
+            CALL correct (  24,160, 23,160)
+            CALL correct (  25,160, 23,160)
+            CALL correct (  26,160, 23,160)
+            CALL correct (  27,160, 23,160)
+            CALL correct (  28,160, 23,160)
+            CALL correct (  29,160, 23,160)
+            CALL correct (  30,160, 33,160)
+            CALL correct (  31,160, 33,160)
+            CALL correct (  32,160, 33,160)
+            CALL correct (  34,160, 33,160)
+            CALL correct (  35,160, 33,160)
+            CALL correct (  36,160, 33,160)
+            CALL correct (  37,160, 33,160)
+            CALL correct (  38,160, 33,160)
+            CALL correct (  39,160, 33,160)
+            CALL correct (  40,160, 49,160)
+            CALL correct (  41,160, 49,160)
+            CALL correct (  42,160, 49,160)
+            CALL correct (  43,160, 49,160)
+            CALL correct (  44,160, 49,160)
+            CALL correct (  45,160, 49,160)
+            CALL correct (  46,160, 49,160)
+            CALL correct (  47,160, 49,160)
+            CALL correct (  48,160, 49,160)
+            CALL correct (  50,160, 57,160)
+            CALL correct (  51,160, 57,160)
+            CALL correct (  52,160, 57,160)
+            CALL correct (  53,160, 57,160)
+            CALL correct (  54,160, 57,160)
+            CALL correct (  55,160, 57,160)
+            CALL correct (  56,160, 57,160)
+            CALL correct (  58,160, 57,160)
+            CALL correct (  59,160, 57,160)
+            CALL correct (  60,160, 57,160)
+            CALL correct (  61,160, 57,160)
+            CALL correct (  62,160, 57,160)
+            CALL correct (  63,160, 57,160)
+            CALL correct (  64,160, 57,160)
+            CALL correct (  65,160, 57,160)
+            CALL correct (  66,160, 57,160)
+            CALL correct (  67,160, 57,160)
+            CALL correct (  68,160, 57,160)
+            CALL correct (  69,160, 57,160)
+            CALL correct (  70,160, 72,160)
+            CALL correct (  71,160, 72,160)
+            CALL correct (  73,160, 72,160)
+            CALL correct (  74,160, 72,160)
+            CALL correct (  75,160, 72,160)
+            CALL correct (  76,160, 72,160)
+            CALL correct (  77,160, 72,160)
+            CALL correct (  78,160, 72,160)
+            CALL correct (  79,160, 72,160)
+            CALL correct (  80,160, 88,160)
+            CALL correct (  81,160, 88,160)
+            CALL correct (  82,160, 88,160)
+            CALL correct (  83,160, 88,160)
+            CALL correct (  84,160, 88,160)
+            CALL correct (  85,160, 88,160)
+            CALL correct (  86,160, 88,160)
+            CALL correct (  87,160, 88,160)
+            CALL correct (  89,160, 88,160)
+            CALL correct (  90,160, 95,160)
+            CALL correct (  91,160, 95,160)
+            CALL correct (  92,160, 95,160)
+            CALL correct (  93,160, 95,160)
+            CALL correct (  94,160, 95,160)
+            CALL correct (  96,160, 95,160)
+            CALL correct (  97,160, 95,160)
+            CALL correct (  98,160, 95,160)
+            CALL correct (  99,160, 95,160)
+            CALL correct ( 100,160, 95,160)
+            CALL correct ( 101,160, 95,160)
+            CALL correct ( 102,160, 95,160)
+            CALL correct ( 103,160, 95,160)
+            CALL correct ( 104,160, 95,160)
+            CALL correct ( 105,160, 95,160)
+            CALL correct ( 106,160, 95,160)
+            CALL correct ( 107,160, 95,160)
+            CALL correct ( 108,160, 95,160)
+            CALL correct ( 109,160, 95,160)
+            CALL correct ( 110,160, 95,160)
+            CALL correct ( 113,160,111,160)
+            CALL correct ( 114,160,111,160)
+            CALL correct ( 115,160,111,160)
+            CALL correct ( 116,160,111,160)
+            CALL correct ( 117,160,111,160)
+            CALL correct ( 118,160,111,160)
+            CALL correct ( 119,160,111,160)
+            CALL correct ( 120,160,111,160)
+            CALL correct ( 121,160,122,160)
+            CALL correct ( 123,160,122,160)
+            CALL correct ( 124,160,122,160)
+            CALL correct ( 125,160,122,160)
+            CALL correct ( 126,160,122,160)
+            CALL correct ( 127,160,122,160)
+            CALL correct ( 129,160,122,160)
+            CALL correct ( 130,160,136,160)
+            CALL correct ( 131,160,136,160)
+            CALL correct ( 132,160,136,160)
+            CALL correct ( 133,160,136,160)
+            CALL correct ( 134,160,136,160)
+            CALL correct ( 135,160,136,160)
+            CALL correct ( 137,160,136,160)
+            CALL correct ( 138,160,136,160)
+            CALL correct ( 139,160,136,160)
+            CALL correct ( 140,160,136,160)
+            CALL correct ( 141,160,136,160)
+            CALL correct ( 142,160,136,160)
+            CALL correct ( 143,160,136,160)
+            CALL correct ( 144,160,136,160)
+            CALL correct ( 145,160,136,160)
+            CALL correct ( 146,160,136,160)
+            CALL correct ( 147,160,136,160)
+            CALL correct ( 148,160,136,160)
+            CALL correct ( 149,160,136,160)
+            CALL correct ( 150,160,136,160)
+            CALL correct ( 151,160,136,160)
+            CALL correct ( 152,160,154,160)
+            CALL correct ( 153,160,154,160)
+            CALL correct ( 156,160,154,160)
+            CALL correct ( 157,160,154,160)
+            CALL correct ( 158,160,154,160)
+            CALL correct ( 159,160,154,160)
+            CALL correct ( 160,160,154,160)
+            CALL correct ( 161,160,154,160)
+            CALL correct ( 162,160,154,160)
+            CALL correct ( 163,160,154,160)
+            CALL correct ( 164,160,171,160)
+            CALL correct ( 165,160,171,160)
+            CALL correct ( 166,160,171,160)
+            CALL correct ( 167,160,171,160)
+            CALL correct ( 168,160,171,160)
+            CALL correct ( 169,160,171,160)
+            CALL correct ( 170,160,171,160)
+            CALL correct ( 172,160,171,160)
+            CALL correct ( 173,160,171,160)
+            CALL correct ( 174,160,171,160)
+            CALL correct ( 175,160,171,160)
+            CALL correct ( 176,160,171,160)
+            CALL correct ( 177,160,171,160)
+            CALL correct ( 178,160,171,160)
+            CALL correct ( 180,160,179,160)
+            CALL correct ( 181,160,179,160)
+            CALL correct ( 182,160,179,160)
+            CALL correct ( 183,160,179,160)
+            CALL correct ( 184,160,179,160)
+            CALL correct ( 185,160,179,160)
+            CALL correct ( 186,160,179,160)
+            CALL correct ( 187,160,179,160)
+            CALL correct ( 188,160,179,160)
+            CALL correct ( 189,160,179,160)
+            CALL correct ( 190,160,195,160)
+            CALL correct ( 191,160,195,160)
+            CALL correct ( 192,160,195,160)
+            CALL correct ( 193,160,195,160)
+            CALL correct ( 194,160,195,160)
+            CALL correct ( 197,160,195,160)
+            CALL correct ( 198,160,195,160)
+            CALL correct ( 199,160,195,160)
+            CALL correct ( 200,160,195,160)
+            CALL correct ( 201,160,195,160)
+            CALL correct ( 202,160,195,160)
+            CALL correct ( 203,160,195,160)
+            CALL correct ( 204,160,195,160)
+            CALL correct ( 205,160,211,160)
+            CALL correct ( 206,160,211,160)
+            CALL correct ( 207,160,211,160)
+            CALL correct ( 208,160,211,160)
+            CALL correct ( 209,160,211,160)
+            CALL correct ( 210,160,211,160)
+            CALL correct ( 212,160,211,160)
+            CALL correct ( 213,160,211,160)
+            CALL correct ( 214,160,211,160)
+            CALL correct ( 215,160,211,160)
+            CALL correct ( 216,160,211,160)
+            CALL correct ( 218,160,211,160)
+            CALL correct ( 219,160,211,160)
+            CALL correct ( 220,160,211,160)
+            CALL correct ( 221,160,211,160)
+            CALL correct ( 222,160,211,160)
+            CALL correct ( 223,160,232,160)
+            CALL correct ( 224,160,232,160)
+            CALL correct ( 225,160,232,160)
+            CALL correct ( 226,160,232,160)
+            CALL correct ( 227,160,232,160)
+            CALL correct ( 228,160,232,160)
+            CALL correct ( 229,160,232,160)
+            CALL correct ( 230,160,232,160)
+            CALL correct ( 231,160,232,160)
+            CALL correct ( 233,160,232,160)
+            CALL correct ( 234,160,232,160)
+            CALL correct ( 235,160,232,160)
+            CALL correct ( 236,160,232,160)
+            CALL correct ( 237,160,232,160)
+            CALL correct ( 238,160,232,160)
+            CALL correct ( 239,160,232,160)
+            CALL correct ( 240,160,232,160)
+            CALL correct ( 241,160,232,160)
+            CALL correct ( 242,160,232,160)
+            CALL correct ( 243,160,247,160)
+            CALL correct ( 244,160,247,160)
+            CALL correct ( 245,160,247,160)
+            CALL correct ( 246,160,247,160)
+            CALL correct ( 248,160,247,160)
+            CALL correct ( 249,160,247,160)
+            CALL correct ( 250,160,247,160)
+            CALL correct ( 251,160,253,160)
+            CALL correct ( 252,160,253,160)
+            CALL correct ( 254,160,253,160)
+            CALL correct ( 255,160,253,160)
+            CALL correct ( 256,160,253,160)
+            CALL correct ( 257,160,253,160)
+            CALL correct ( 258,160,253,160)
+            CALL correct ( 259,160,253,160)
+            CALL correct ( 260,160,253,160)
+            CALL correct ( 261,160,253,160)
+            CALL correct ( 262,160,268,160)
+            CALL correct ( 263,160,268,160)
+            CALL correct ( 264,160,268,160)
+            CALL correct ( 265,160,268,160)
+            CALL correct ( 266,160,268,160)
+            CALL correct ( 267,160,268,160)
+            CALL correct ( 270,160,268,160)
+            CALL correct ( 271,160,268,160)
+            CALL correct ( 272,160,268,160)
+            CALL correct ( 273,160,268,160)
+            CALL correct ( 274,160,268,160)
+            CALL correct ( 275,160,268,160)
+            CALL correct ( 276,160,268,160)
+            CALL correct ( 277,160,268,160)
+            CALL correct ( 278,160,268,160)
+            CALL correct ( 279,160,268,160)
+            CALL correct ( 280,160,268,160)
+            CALL correct ( 281,160,285,160)
+            CALL correct ( 282,160,285,160)
+            CALL correct ( 283,160,285,160)
+            CALL correct ( 284,160,285,160)
+            CALL correct ( 286,160,285,160)
+            CALL correct ( 287,160,285,160)
+            CALL correct ( 288,160,285,160)
+            CALL correct ( 289,160,285,160)
+            CALL correct ( 290,160,285,160)
+            CALL correct ( 291,160,285,160)
+            CALL correct ( 292,160,285,160)
+            CALL correct ( 294,160,285,160)
+            CALL correct ( 295,160,285,160)
+            CALL correct ( 296,160,285,160)
+            CALL correct ( 297,160,309,160)
+            CALL correct ( 298,160,309,160)
+            CALL correct ( 299,160,309,160)
+            CALL correct ( 300,160,309,160)
+            CALL correct ( 301,160,309,160)
+            CALL correct ( 302,160,309,160)
+            CALL correct ( 303,160,309,160)
+            CALL correct ( 304,160,309,160)
+            CALL correct ( 305,160,309,160)
+            CALL correct ( 306,160,309,160)
+            CALL correct ( 307,160,309,160)
+            CALL correct ( 308,160,309,160)
+            CALL correct ( 312,160,309,160)
+            CALL correct ( 313,160,309,160)
+            CALL correct ( 314,160,309,160)
+            CALL correct ( 315,160,309,160)
+            CALL correct ( 316,160,309,160)
+            CALL correct ( 317,160,309,160)
+            CALL correct ( 318,160,309,160)
+            CALL correct ( 319,160,309,160)
+            CALL correct ( 320,160,309,160)
+         ENDIF
+      END IF
+      !
+      RETURN
+   END SUBROUTINE correct_t106_orca2
+END MODULE mod_correct
Index: /TOOLS/MOZAIC/src/MOZAIC/cotes.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/cotes.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/cotes.f90	(revision 3326)
@@ -0,0 +1,1533 @@
+! -*- Mode: f90 -*-
+PROGRAM cote
+   USE declare
+   USE modeles
+   USE mod_lecdata
+   USE formula
+   USE math
+   USE mod_rectifie
+   USE mod_lbc
+   USE mod_norma
+   USE bords
+   USE mod_inter
+   USE mod_prih
+   USE mod_wri_wei
+   USE mod_inipar
+   USE fliocom
+   USE getincom
+   USE errioipsl
+!!!
+   IMPLICIT NONE
+!!!
+!!!   A partir d'un fichier de poids, complete avec les rivieres et
+!!!   les poids pour le run off
+   !! On met a zero les poids sur les points non cotiers, et on renormalise
+   !!
+   INTEGER (kind=il), PARAMETER :: jpr = 52 ! Nombre de rivieres
+   REAL (kind=rl) :: zsuma, zsumo
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: za
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zo
+   !!
+   CHARACTER (LEN = 1) :: clriv
+   CHARACTER (LEN = 30) :: clname
+   INTEGER (kind=il) :: ja, jo, jo2, jo3, jn, jno, joi, joj, jai, jaj, jr, kn  ! indices de boucle
+   INTEGER (kind=il) :: jai_p, jai_m, jaj_p, jaj_m, n1
+   INTEGER (kind=il) :: joi_p, joi_m, joj_p, joj_m
+   REAL (kind=rl) :: z_d_1, z_d_2, zzmin
+   INTEGER (kind=il) :: nriv = 32, nlmd = 35
+   INTEGER (kind=il), DIMENSION (:, :), ALLOCATABLE :: jx ! Point trouve sous une maille atm
+   INTEGER (kind=il) :: kom, ko
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: lacot, laland, laoce, lanoroute
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: locot, looce
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE  :: wtemp, d_cote
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: ktemp2
+   REAL(kind=rl), DIMENSION (:,:), ALLOCATABLE  :: wtemp2
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: iamsk
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: iomsk
+   INTEGER (kind=il) :: jovoid, jot, inum
+   CHARACTER (len=80) :: cfname4, cfname8
+   LOGICAL :: ltrouve, ltrouve2
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: itarget
+   REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: wtarget
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: i2a
+   INTEGER (kind=il) :: no, ntrouve
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: jo_n
+   LOGICAL :: l_fulldiag = .TRUE.
+   CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: tmask_atl, tmask_noclose, tmask_nomed, tmask_med
+   REAL(kind=rl), DIMENSION (:, :), ALLOCATABLE  :: z2o
+   CHARACTER (len=40) :: cl_bassin
+   INTEGER (kind=il) :: il_ncid
+   !!
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   INTEGER (kind=il) :: ierr
+   !!
+   !! Recherche voisins proches
+   INTEGER (kind=il) :: jp_nb
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: jo_tab
+   INTEGER (kind=il) :: jo_nb
+   !!
+   INTEGER :: nid_it
+   !!
+   CHARACTER (len = 50) :: cldiag_a2o, clw_a2o, clw_a2o_cdf, clw_a2o_mct
+   CHARACTER (len = 25) :: mo_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   CALL inipar
+   CALL alloc_modeles
+
+   !!
+   ALLOCATE (za      (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'za', lreset=.TRUE., crout='cotes')
+   ALLOCATE (zo      (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'zo')
+   ALLOCATE (jx      (jpo2a,2)   , STAT=ierr) ; CALL chk_allo (ierr, 'jx')
+   ALLOCATE (lacot   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'lacot')  ; lacot  = .FALSE.
+   ALLOCATE (laland  (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'laland') ; laland = .FALSE.
+   ALLOCATE (laoce   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'laoce')  ; laoce  = .FALSE.
+   !
+   ALLOCATE (locot   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'locot')  ; locot  = .FALSE.
+   ALLOCATE (looce   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'looce')  ; looce  = .FALSE.
+   !
+   ALLOCATE (ktemp   (jpa2o)     , STAT=ierr) ; CALL chk_allo (ierr, 'ktemp')
+   ALLOCATE (wtemp   (jpa2o)     , STAT=ierr) ; CALL chk_allo (ierr, 'wtemp')
+   ALLOCATE (iamsk   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'iamsk')
+   ALLOCATE (iomsk   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'iomsk')
+   ALLOCATE (d_cote  (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'd_cote')
+   !
+   ALLOCATE (itarget (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'itarget')
+   ALLOCATE (wtarget (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'wtarget')
+   ALLOCATE (i2a     (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'i2a')
+   !
+   ALLOCATE (tmask_atl     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_atl')
+   ALLOCATE (tmask_noclose (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_noclose')
+   ALLOCATE (tmask_nomed   (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmasl_nomed')
+   ALLOCATE (tmask_med     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_med')
+   ALLOCATE (z2o (jpoi, jpoj), STAT=ierr)     ; CALL chk_allo (ierr, 'z2o')
+   !
+   jp_nb = jpon
+   ALLOCATE (jo_tab (jpon)) ; CALL chk_allo (ierr, 'jo_tab')
+   !
+   IF (l_limit_iosize) l_fulldiag = .FALSE.
+   !!
+   !! Initialisation
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13 ; nchk = 14 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 81 ; nwei8o2a = 82 ; nwei4a2o = 83 ; nwei8a2o = 84
+   !
+   nout = 6
+   IF (nout /= 6 .AND. nout /= 0 ) &
+      & OPEN (unit = nout, file = 'cote' // TRIM(c_suffix) // '.out', action = 'WRITE', status = 'unknown', position = 'REWIND' )
+   !!
+   !! Diagnostics files
+   !!
+   IF (nout /= 6 ) &
+      &  OPEN (unit = nout, file = 'cotes' // TRIM(c_suffix) // '.out', position = 'REWIND', action = 'WRITE', status = 'replace' )
+   !!
+   !! Read coordinates of all models, and weights
+   !!
+   CALL lecdata (lecweights = .TRUE., leco2amask = .TRUE. )
+
+   !! Lecture masques de bassin
+   IF ( TRIM (cotyp) == 'orca4' .OR. &
+      & TRIM (cotyp) == 'orca2' .OR. TRIM (cotyp) == 'orca2.0' .OR. TRIM (cotyp) == 'orca2.1' .OR. TRIM (cotyp) == 'orca2.3' .OR. &
+      & TRIM (cotyp) == 'orca1' &
+      & ) THEN 
+      cl_bassin = TRIM (cotyp)
+!-$$      IF (c_period /= 'none' ) cl_bassin = TRIM (cl_bassin) // TRIM (c_period)
+      cl_bassin = TRIM (cl_bassin) // '.nc'
+      WRITE (nout,*) 'Reading bassin masks in : ', TRIM (cl_bassin)
+      CALL flioopfd (TRIM (cl_bassin), il_ncid )
+      CALL fliogetv (il_ncid, 'mask_atl'    , z2o )
+      tmask_atl = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_noclose', z2o )
+      tmask_noclose = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_nomed'  , z2o )
+      tmask_nomed = RESHAPE (z2o, (/ jpon /) )
+      CALL flioclo (il_ncid)
+   ELSE
+      tmask_atl     = REAL (1-iomskt, rl)
+      tmask_noclose = REAL (1-iomskt, rl)
+      tmask_nomed   = REAL (1-iomskt, rl)
+   END IF
+   !
+   WRITE (unit=nout, fmt=*) 'iomskt'
+   CALL prihin (RESHAPE(iomskt             ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_atl'
+   CALL prihin (RESHAPE(NINT(tmask_atl)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_med'
+   !CALL prihin (RESHAPE(NINT(tmask_med)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_noclose'
+   !CALL prihin (RESHAPE(NINT(tmask_noclose),(/jpoi,jpoj/)), 1_il, nout)
+   !
+   ! Set correct periodicity to grids
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+   CALL lbc (xalont, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalonu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalonv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !!
+   CALL rectifie
+   !!
+   CALL fliocrfd ('itarget' // TRIM(c_suffix), (/'x', 'y'/), (/jpai, jpaj/), nid_it, mode='REPLACE')
+   CALL flioputa (nid_it, "?", "title"         , "itarget" )
+   CALL flioputa (nid_it, '?', 'Comment', TRIM(c_comment) )
+   CALL DATE_AND_TIME (c_date, c_time, c_zone )
+   CALL flioputa (nid_it, "?", "history"       , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"// &
+      & c_date(7:8)//" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) )
+   CALL flioputa (nid_it, "?", "method"        , "MOSAIC" )
+   CALL flioputa (nid_it, "?", "source_grid"   , "curvilinear" )
+   CALL flioputa (nid_it, "?", "dest_grid"     , "curvilinear" )
+   CALL flioputa (nid_it, "?", "Institution"   , "IPSL" )
+   CALL flioputa (nid_it, "?", "Model"         , "IPSL CM6" )
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME", VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_it, "?", "HOSTNAME"     , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $HOSTNAME'
+   END IF
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_it, "?", "LOGNAME"      , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $LOGNAME'
+   END IF
+
+   CALL fliodefv (nid_it, 'lon', (/1, 2/), units="degree_north", v_t=flio_r4 )
+   CALL fliodefv (nid_it, 'lat', (/1, 2/), units="degree_east",  v_t=flio_r4 )
+   CALL fliodefv (nid_it, 'o2amask', (/1,2/), v_t=flio_r4)
+   CALL fliodefv (nid_it, 'laland', (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'lacot' , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'laoce' , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'iamskp', (/1,2/), v_t=flio_i4)
+
+   CALL flioputv (nid_it, 'lon'    , RESHAPE ( xalont, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'lat'    , RESHAPE ( xalatt, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'o2amask', RESHAPE (o2amask, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'iamskp' , RESHAPE (iamskp , (/jpai, jpaj/)) )
+   !!
+   !! Compute edges of grid boxes
+   !!
+   CALL bord_a
+   CALL bord_o
+   CALL bord_oa
+   !!
+   mo_name  = "mozaic"
+   a2o_name = "a2o"
+   !!
+   WRITE (nout,*) 'o2amask (>0, <=0, >1) ', COUNT (o2amask >  0.0_rl), COUNT (o2amask <= 0.0_rl) &
+      &                     , COUNT (o2amask >= 1.0_rl)
+   i2a = 0_il
+   WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) 
+      i2a = 1_il
+   END WHERE
+   WRITE (nout, *) 'i2a (o2amask > 0)'
+   CALL prihin (i2a , 1_il, nout)
+   !!
+   !! Verif poids avant reduction
+   !!
+   WRITE (unit=nout,fmt=*) 'Verif poids globale'
+   za = 0.0_rl
+   WRITE (nout, *) 'Comptage xasrft  ' , COUNT ( xasrft < 1.0E-10_rl )
+   WRITE (nout, *) 'Comptage o2amask ' , COUNT ( o2amask < 0.5_rl )
+   WHERE ( xasrft * o2amask /= 0.0_rl )
+      za = 1.0_rl / (xasrft * o2amask)
+   END WHERE
+   WRITE (nout, *) 'Somme za     ', SUM ( za)
+   WRITE (nout, *) 'Somme xasrft ', SUM ( xasrft)
+   zsuma = DOT_PRODUCT (za, xasrft * o2amask)
+   !!
+   WRITE (nout, *) 'jma2o for coastal runoff : ', jma2o
+   !! Atm mask interpolated to oce
+   za = REAL (1_il-iamskt, KIND = rl )
+   CALL inter_a2o (za, a2omask )
+   !! 1 on Atm interpolated to oce
+   za = REAL (1_il       , KIND = rl )
+   CALL inter_a2o (za, a2ofull )
+   !!
+   CALL verif ('Apres lecture')
+   !!
+   CALL bilan ("Poids ", c_case="complet", c_int_atm="Local", c_int_oce="Local")
+   CALL bilan ("Poids ", c_case="ocean"  , c_int_atm="Local", c_int_oce="Local")
+   !!
+   !! Remise des poids en integre
+   DO jn = 1, jpa2o
+      DO jo = 1, jpon
+         ja = ka2o (jn, jo)
+         IF (ja > 0) THEN 
+            IF ( o2amask (ja) .GT. 0.0_rl) &
+               & wa2o (jn, jo) = wa2o (jn, jo) * xosrft (jo) / ( xasrft (ja) * o2amask (ja))
+         END IF
+      END DO
+   END DO
+   !
+   CALL bilan ("Integre ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+   CALL bilan ("Integre ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+   CALL bilan ("Integre ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+   !!
+   E_DRYRUN: IF (l_dryrun) THEN
+      WRITE (nout,*) "Remplissage bidon des champs pour tester les I/O"
+      jma2o = jma2or
+      nvo = jma2or
+      WRITE (nout,*) 'jma2o pour test : ', jma2o
+      CALL RANDOM_SEED
+      CALL RANDOM_NUMBER (wa2o) ; ka2o = NINT (wa2o*REAL(jpan,rl) )
+
+      DO jo = 1, jpon
+         IF ( iomskt (jo) == 1 ) THEN
+            wa2o (:, jo) = 0.0_rl
+            ka2o (:, jo) = 0_il
+         END IF
+      END DO
+
+      DO jo = 1, jpon
+         DO jno = 1, jpa2o
+            ja = ka2o (jno, jo)
+            IF (ja > 0) THEN 
+               IF (iamskt (ja) == 1) THEN
+                  wa2o (jno, jo) = 0.0_rl ; ka2o (jno, jo) = 0_il
+               END IF
+            END IF
+         END DO
+      END DO
+   ELSE
+      L_lcoast: IF (lcoast) THEN
+         !! Dataset 4 : idem 2, mais en interpolant seulement des points cotes atmosphere vers
+         !! les points cotes ocean.
+         WRITE (nout,*) 'Demarrage L_coast'
+         !!
+         WRITE (nout,*) 'Calculs points terre/oce/cote sur grille atmosphere'
+         WHERE (o2amask .LT. epsfrac                                     ) laland = .TRUE.
+         WHERE (o2amask .GE. epsfrac .AND. o2amask .LE. (1.0_rl-epsfrac) ) lacot  = .TRUE.
+         WHERE (                           o2amask .GT. (1.0_rl-epsfrac) ) laoce  = .TRUE.
+
+         WRITE (UNIT=nout, FMT=*) 'Points cotiers ', COUNT(lacot)
+
+         WRITE (nout,*) 'Ecriture '
+         i2a = 0
+         WHERE (RESHAPE(laland,(/jpai,jpaj/))) i2a=1
+         CALL flioputv (nid_it, "laland", i2a)
+         i2a = 0
+         WHERE (RESHAPE(laoce ,(/jpai,jpaj/))) i2a=1 
+         CALL flioputv (nid_it, "laoce", i2a)
+         i2a = 0
+         WHERE (RESHAPE(lacot ,(/jpai,jpaj/))) i2a=1
+         CALL flioputv (nid_it, "lacot", i2a)
+
+         WRITE (nout,*) 'Determination des points cotes ocean '
+         ALLOCATE (ktemp2(jpoi,jpoj))
+         ktemp2 = 0_il
+         locot = .FALSE.
+         looce = .FALSE.
+         IF ( lcoast ) THEN 
+            DO jo = 1, jpon
+               joi = moi (jo) ; joj = moj (jo) ! Indices 2D
+               joi_p = joi+1            ; joi_m = joi-1
+               joj_p = MIN(joj+1, jpoj) ; joj_m = MAX (joj-1, 1)
+               IF ( iomskt (jo) == 0_il .AND. iomskp (jo) == 0_il ) THEN
+                  IF (    iomskt (m1o (joi_p, joj  )) == 1  &
+                     .OR. iomskt (m1o (joi_m, joj  )) == 1  &
+                     .OR. iomskt (m1o (joi  , joj_p)) == 1  &
+                     .OR. iomskt (m1o (joi  , joj_m)) == 1  &
+                     .OR. iomskt (m1o (joi_p, joj_p)) == 1  &
+                     .OR. iomskt (m1o (joi_p, joj_m)) == 1  &
+                     .OR. iomskt (m1o (joi_m, joj_p)) == 1  &
+                     .OR. iomskt (m1o (joi_m, joj_m)) == 1  ) THEN
+                     locot (jo) = .TRUE.
+                     ktemp2 (joi, joj) = 1_il
+                  ELSE 
+                     looce (jo) = .TRUE.
+                  END IF
+               END IF
+            END DO
+         ELSE
+            locot (:) = ( iomskt == 0 )
+         ENDIF
+         CALL lbc (locot, noperio, 'T', jpoi, jpoj)
+         CALL lbc (looce, noperio, 'T', jpoi, jpoj)
+         WRITE (nout,*) "iomskt"
+         CALL prihin (RESHAPE(iomskt,(/jpoi,jpoj/)), 1, nout)
+         WRITE (nout,*) "Locot"
+         CALL prihin (ktemp2, 1, nout)
+         DEALLOCATE (ktemp2)
+         WRITE (nout,*) 'Verif coherence (tout doit etre nul)'
+         WRITE (nout,*) COUNT ( laland .AND. lacot)
+         WRITE (nout,*) COUNT ( lacot  .AND. laoce)
+         WRITE (nout,*) COUNT ( laoce  .AND. laland)
+         WRITE (nout,*) COUNT ( .NOT. ( laland .OR. lacot .OR. laoce) )
+
+!-$$      iamsk = 0 ; WHERE (lacot) iamsk = 1
+!-$$      WRITE(nout,*) 'Fraction lacot'
+!-$$      CALL prihin(RESHAPE(iamsk,(/jpai,jpaj/)),1_il,nout)
+!-$$
+!-$$      iamsk = 0 ; WHERE (laland) iamsk = 1
+!-$$      WRITE(nout,*) 'Points avec terre laland'
+!-$$      CALL prihin(RESHAPE(iamsk,(/jpai,jpaj/)),1_il,nout)
+!-$$
+!-$$      iamsk = 0 ; WHERE (laoce) iamsk = 1
+!-$$      WRITE(nout,*) 'Fraction laoce'
+!-$$      CALL prihin(RESHAPE(iamsk,(/jpai,jpaj/)),1_il,nout)
+!-$$
+!-$$      WRITE(nout,*) 'Periodicite atm'
+!-$$      CALL prihin(RESHAPE(iamskp,(/jpai,jpaj/)),1_il,nout)
+         !!
+         WRITE (nout,*) "iamskt"
+         CALL prihin (RESHAPE(iamskt,(/jpai,jpaj/)), 1, nout)
+         WRITE (nout,*) "Lacot"
+         ALLOCATE (ktemp2 (jpai, jpaj))
+         ktemp2 = 0_il ; WHERE (RESHAPE(lacot, (/jpai, jpaj/))) ktemp2 = 1_il
+         CALL prihin (ktemp2, 1, nout)
+         !!
+         WRITE (unit = nout, fmt = *) 'Nombre de points cotes atmosphere : ', COUNT (lacot)
+         WRITE (unit = nout, fmt = *) 'Nombre de points cotes ocean      : ', COUNT (locot)
+         !!
+         CALL bilan ("Avec cote ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Avec cote ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Avec cote ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+         !
+         ! Mise a zero des poids sur les points non cotiers
+         DO jo = 1, jpon
+            IF (.NOT. locot (jo)             ) THEN
+               wa2o (:, jo) = 0.0e0_rl
+               ka2o (:, jo) = 0_il
+            ELSE
+               DO jn = 1, jpa2o
+                  ja = ka2o (jn, jo)
+                  IF (ja > 0 ) THEN
+                     IF (.NOT. lacot (ja) ) THEN
+                        wa2o (jn, jo) = 0.0e0_rl
+                        ka2o (jn, jo) = 0_il
+                     END IF
+                  END IF
+               END DO
+            END IF
+         END DO
+         CALL verif ('Apres remise a zero')
+         !!
+         !! Elimination des points redondant par periodicite
+         DO jo = 1, jpon
+            IF (iomskp (jo) .EQ. 1_il ) THEN
+               wa2o (:,jo) = 0.0e0_rl
+               ka2o (:,jo) = 0_il
+            END IF
+         END DO
+         !!
+         !! Controle
+         !! 
+         CALL verif ('Apres elimination de periodicite')
+         !!
+         CALL bilan ("Apres remise a zero ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+         !!
+         
+         !! Etalement sur l'océan
+         
+!-$$         EtalOce : IF ( l_etal_oce ) THEN
+!-$$            EtalOce_1 : DO jo = 1, jpon
+!-$$               IF (.NOT. locot (jo)    ) CYCLE EtalOce_1
+!-$$               ! Recherche des points proches, non ocean
+!-$$               n_trouve = 0
+!-$$               z_surf_total = xosrft (jo)
+!-$$               wa2o (:,jo) ???
+!-$$               EtalOce_2 : DO jo2 = 1, jpon
+!-$$                  IF ( locot (jo) .OR.   iomskt (jo) == 1  ) CYCLE EtalOce_2
+!-$$                  z_d_1 =  r_earth * REAL (geodist(xalont(jo), xolatt(jo), xolont(jo2), xolatt(jo2)), KIND=rl)
+!-$$                  IF ( z_d_1 .LE. dist_etal_oce ) THEN
+!-$$                     DO jn = 1, nva (jo)
+!-$$                        ja  = ka2o (jn, jo)
+!-$$                        kom = kom + 1
+!-$$                        jxx (jn, kom, :) = (/ jo2 /)
+!-$$                     END DO
+!-$$                     
+!-$$                        
+!-$$             
+!-$$                        nva (jo2) = nvo (jo2) + 1
+!-$$                        ka2o ( nva(jo2), jo2) = ja 
+!-$$                        wa2o ( nva(jo2), jo2) = wa2o ( jn, jo)
+!-$$                     END DO
+!-$$                     z_surf_total = zsurf_total + xosrft (jo2)
+!-$$                     ! ????
+!-$$                  END IF
+!-$$                  
+!-$$               END DO EtalOce_2
+!-$$            END DO EtalOce_1
+!-$$         END IF EtalOce
+         !!
+         !! Renormalize
+         ! Cas 1
+         RenormA : DO ja = 1, jpan
+            IF (.NOT. lacot (ja) ) CYCLE RenormA
+            z_d_1 = 0.0e0_rl
+            kom = 0
+            RenormO : DO jo = 1, jpon
+               !IF (.NOT. locot (jo) ) CYCLE RenormO
+               DO jn = 1, jpa2o
+                  IF ( ka2o (jn,jo) == ja ) THEN
+                     z_d_1 = z_d_1 + wa2o (jn,jo) 
+                     kom = kom + 1
+                     jx (kom,:) = (/ jn, jo /)
+                     !!$ WRITE (unit = nout, fmt = '(6I6,16F18.6) ') ja, jo, jn, kom, jx (kom, :), &
+                     !!$   wa2o (jn,jo), wa2o (jx (kom, 1), jx (kom, 2)), z_d_1, &
+                     !!$   xosrft (jo), xasrft (ja)
+                  END IF
+               END DO
+            ENDDO RenormO
+            IF (kom /= 0 ) THEN
+               IF (z_d_1 == 0.0_rl ) THEN
+                  WRITE (nout, *) 'z_d_1 nul ', ja, xasrft (ja), lacot (ja), iamskt (ja), &
+                     & wa2o (:,ja), ka2o (:,ja)
+                  STOP
+               ELSE
+                  DO ko = 1, kom
+                     wa2o (jx (ko,1), jx (ko,2)) = wa2o (jx (ko,1), jx (ko,2)) / z_d_1
+                  END DO
+               ENDIF
+            END IF
+         ENDDO RenormA
+         !!
+         !! Calcul des distances à la cote des points oceans
+!-$$      WRITE (nout,*) 'Distance cotes'
+!-$$      d_cote = rpi
+!-$$      Cal_dist_1: DO jo = 1, jpon
+!-$$         IF ( iomskt (jo) == 1 .OR. locot (jo) ) THEN 
+!-$$            d_cote (jo) = 0.0E0_rl
+!-$$         ELSE
+!-$$            Cal_dist_2:DO jo2 = 1, jpon
+!-$$               IF ( locot (jo2) ) THEN 
+!-$$                  d_cote (jo) = MIN (d_cote (jo),  REAL (geodist(xolont(jo), xolatt(jo), xolont(jo2), xolatt(jo2)), KIND=rl))
+!-$$               END IF
+!-$$            END DO Cal_dist_2
+!-$$         END IF
+!-$$      END DO Cal_dist_1
+!-$$      d_cote = d_cote * r_earth
+         !CALL prihre (RESHAPE(d_cote,(/jpoi,jpoj/)), 1.0E-5_rl, nout)
+         WRITE (nout,*) 'Distance maxi a la cote (ocean) : ', MAXVAL (d_cote)
+         CALL fliocrfd ("dist_cote" // TRIM(c_suffix), (/ "x", "y"/), (/jpoi, jpoj/), n1, MODE="REPLACE")
+         CALL flioputa (n1, '?', 'Comment', TRIM(c_comment) )
+         CALL fliodefv (n1, "dist_cote", (/1, 2/))
+         CALL flioputv (n1, "dist_cote", RESHAPE (d_cote, (/jpoi, jpoj/) ))
+         CALL flioclo (n1)
+         !
+         !! Controle
+         !! 
+         CALL verif ('Premiere normalisation')
+         CALL gather_wei ('Premiere etape')
+         CALL verif ('Premier gather')
+         !!
+         CALL bilan ("Renorm ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Renorm ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+         CALL bilan ("Renorm ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+
+         !!
+         !! Traitement des points atmospheres non atteint
+         !!
+         total: IF (ltotal) THEN
+            WRITE (nout,*) 'Va chercher tout les points terre (ltotal=TRUE)'
+            SeekAtm_1_1: DO ja = 1, jpan
+!-$$            WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja), itarget(ja), iamskp(ja), laland(ja), lacot(ja), laoce(ja)
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_1_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_1_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_1_1
+               zzmin = REAL (cartdist(0.0_rl, 90.0_rl, 0.0_rl, -90.0_rl), KIND=rl)
+               ltrouve = .FALSE. ; jot = 0_il
+!-$$            WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_1_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (.NOT. locot (jo)    ) CYCLE SeekOce_1_1
+                  IF (iomskp(jo) .EQ. 1_il) CYCLE SeekOce_1_1
+                  z_d_1 =  REAL (cartdist(xalont(ja), xalatt(ja), xolont(jo), xolatt(jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1
+                     ltrouve = .TRUE. ; jot = jo
+                  END IF
+               ENDDO SeekOce_1_1
+               Trouve_1_1: IF (ltrouve) THEN
+                  ! Calcul du poids
+                  z_d_1 = 1.0_rl
+                  ! Rangement des poids
+                  IF (nvo (jot) < jpa2o ) THEN ! Reste un poids libre
+                     nvo (jot) = nvo (jot) + 1
+                     wa2o (nvo (jot), jot) = z_d_1
+                     ka2o (nvo (jot), jot) = ja
+!-$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                  ELSE ! Trouve12
+                     WRITE(nout,*) '  Plus de place ', ja, jot, nvo (jot), z_d_1
+                     STOP
+                  ENDIF
+               ELSE ! Trouve
+                  !! Message d'erreur
+                  WRITE (unit = nout, fmt = '("Pas de voisin proche pour ", 1I5,2I4)' ) ja, m2ai(ja), m2aj(ja)
+               END IF Trouve_1_1
+            END DO SeekAtm_1_1
+            !!
+            CALL verif ('ltotal avant gather')
+            CALL bilan ("Ltotal avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total')
+            CALL verif ( 'Cas total', l_non_a=.TRUE.)
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total
+         !!
+         Total_dist: IF (ltotal_dist) THEN
+            !! On limite la recherche à une certaine distance de la cote.
+            WRITE (nout,*) 'Cas ltotal_dist'
+            SeekAtm_2_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_2_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_2_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_2_1
+               zzmin = dist_max
+               ltrouve = .FALSE. ; jot = 0_il
+               !$$$            WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_2_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (.NOT. locot (jo)    ) CYCLE SeekOce_2_1
+                  IF (iomskp(jo) .EQ. 1_il) CYCLE SeekOce_2_1
+                  z_d_1 =  r_earth * REAL (geodist(xalont(ja), xalatt(ja), xolont(jo), xolatt(jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1
+                     ltrouve = .TRUE. ; jot = jo
+                  END IF
+               ENDDO SeekOce_2_1
+               Trouve_2_1: IF (ltrouve) THEN
+                  ! Calcul du poids
+                  z_d_1 = 1.0_rl
+                  IF (nvo (jot) < jpa2o ) THEN ! Reste un poids libre
+                     nvo (jot) = nvo (jot) + 1
+                     wa2o (nvo (jot), jot) = z_d_1
+                     ka2o (nvo (jot), jot) = ja
+                     !$$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                  ELSE 
+                     WRITE(nout,*) '  Plus de place ', ja, jot, nvo (jot), z_d_1
+                     STOP
+                  ENDIF
+               END IF Trouve_2_1
+            END DO SeekAtm_2_1
+            !!
+            CALL verif ('Ltotal_dist avant gather')
+            CALL bilan ("Ltotal_dist avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total_dist')
+            CALL verif ( 'Cas total_dist')
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal_dist ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total_dist
+         !!
+         Total_dist_2: IF (ltotal_dist_2) THEN
+            !! On limite la recherche à une certaine distance de la cote.
+            !! On etale sur les point oceans cotiers proches
+            WRITE (nout,*) '-------------------'
+            WRITE (nout,*) 'Cas ltotal_dist_2'
+            WRITE (nout,*) 'Distance recherche        : ', dist_max/1.0E3_rl, 'km'
+            WRITE (nout,*) 'Distance etalement ocean  : ', dist_max_oce/1.0E3_rl, 'km'
+            !!
+            SeekAtm_3_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_3_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_3_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_3_1
+               zzmin = dist_max
+               ltrouve = .FALSE. ; jot = 0_il ; ntrouve = 0
+               !WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_3_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (.NOT. locot (jo)     ) CYCLE SeekOce_3_1
+                  IF (iomskp (jo) .EQ. 1_il) CYCLE SeekOce_3_1
+                  z_d_1 =  r_earth * REAL (geodist (xalont (ja), xalatt (ja), xolont (jo), xolatt (jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN 
+                     zzmin = z_d_1 ; ltrouve = .TRUE. ; jot = jo ; ntrouve = ntrouve+1
+                  END IF
+               ENDDO SeekOce_3_1
+               WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot, ntrouve
+               Trouve_3_1: IF (ltrouve) THEN
+                  ! On cherche les points proches du point ocean trouve
+                  z_d_1    = 0.0_rl ; jo_tab = 0 ; jo_nb  = 0
+                  SeekOce_3_2: DO jo2 = 1, jpon
+                     IF (.NOT. locot (jo2)     ) CYCLE SeekOce_3_2
+                     IF (iomskp (jo2) .EQ. 1_il) CYCLE SeekOce_3_2
+                     IF ( r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jo2), xolatt (jo2)), KIND=rl) &
+                        &    < dist_max_oce) THEN 
+                        IF (jo_nb >= jp_nb) THEN
+                           WRITE (nout,*) 'Trop de point proches ', ja, jot, jo_tab 
+                           STOP
+                        ELSE
+                           jo_nb = jo_nb + 1
+                           z_d_1 = z_d_1 + xosrft (jo2)
+                           jo_tab (jo_nb) = jo2
+                        END IF
+                     END IF
+                     ! Calcul du poids
+                  END DO SeekOce_3_2
+                  IF (jo_nb == 0) THEN
+                     WRITE (nout,*) 'Pas de voisin au voisin ! ', ja, jot, m2oi(jot), m2oj(jot), xolont(jot), xolatt(jot)
+                     WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+                     WRITE (nout,*) r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jot), xolatt (jot)), KIND=rl)
+                     STOP
+                  ELSE
+!-$$                  WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot, jo_nb, jo_tab (1:jo_nb)
+                     DO jn = 1, jo_nb
+                        jo3 = jo_tab (jn)
+                        IF (nvo (jo3) < jpa2o ) THEN ! Reste un poids libre
+                           nvo (jo3) = nvo (jo3) + 1
+                           wa2o (nvo (jo3), jo3) = xosrft (jo3) / z_d_1
+                           ka2o (nvo (jo3), jo3) = ja
+                           !$$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                        ELSE 
+                           WRITE(nout,*) '  Plus de place ', ja, jo3, nvo (jo3), z_d_1
+                           STOP
+                        ENDIF
+                     END DO
+                  END IF
+!-$$               ELSE
+!-$$                  WRITE (nout,*) 'Pas de voisins proche trouve '
+!-$$                  WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+!-$$                  WRITE (nout,*) dist_max, zzmin, z_d_1
+!-$$                  !STOP
+               END IF Trouve_3_1
+            END DO SeekAtm_3_1
+
+            !!
+            CALL verif ('Ltotal_dist_2 avant gather')
+            CALL bilan ("Ltotal_dist_2 avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_2 avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_2 avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !! 
+            CALL gather_wei ('apres total_dist_2')
+            CALL verif ( 'Cas total_dist_2')
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal_dist_2 ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_2 ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_2 ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total_dist_2
+         !!
+         Total_dist_3: IF (ltotal_dist_3) THEN
+            !! On limite la recherche a une certaine distance de la cote.
+            !! On etale sur les point oceans proches, cote ou pas
+            WRITE (nout,*) '-------------------'
+            WRITE (nout,*) 'Cas ltotal_dist_3'
+            WRITE (nout,*) 'Distance recherche atm    : ', dist_max_atm/1.0E3_rl, 'km'
+            WRITE (nout,*) 'Distance etalement ocean  : ', dist_max_oce/1.0E3_rl, 'km'
+            !!
+            SeekAtm_4_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_4_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_4_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_4_1
+               zzmin = dist_max_atm
+               ltrouve = .FALSE. ; jot = 0_il
+!-$$            WRITE(nout,*) 'Point atm : ', ja, m2ai(ja), m2aj(ja)
+               SeekOce_4_1: DO jo = 1, jpon ! Cherche point ocean le plus proche
+                  IF (iomskp (jo) .EQ. 1_il .OR. iomskt (jo) .EQ. 1_il ) CYCLE SeekOce_4_1
+                  z_d_1 =  r_earth * REAL (geodist (xalont (ja), xalatt (ja), xolont (jo), xolatt (jo)), KIND=rl)
+                  IF (z_d_1 .LT. zzmin) THEN
+                     zzmin = z_d_1 ; ltrouve = .TRUE. ; jot = jo
+                  END IF
+               ENDDO SeekOce_4_1
+!-$$            WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot
+               Trouve_4_1: IF (ltrouve) THEN
+                  ! On cherche les points proches du point ocean trouve, le long de la cote et vers le large
+                  z_d_1    = 0.0_rl ; jo_tab = 0 ; jo_nb  = 0
+                  SeekOce_4_2: DO jo2 = 1, jpon
+                     IF (iomskp (jo2) .EQ. 1_il .OR. iomskt (jo2) .EQ. 1_il) CYCLE SeekOce_4_2
+                     IF ( .NOT. l_large .AND. .NOT. locot (jo2)) CYCLE SeekOce_4_2
+                     z_d_2 =  r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jo2), xolatt (jo2)), KIND=rl)
+                     IF (      (       locot (jo2)  .AND. z_d_2 < dist_max_oce  ) &
+                        .OR. ( .NOT. locot (jo2)  .AND. z_d_2 < dist_max_large ) ) THEN
+                        IF (jo_nb > jp_nb) THEN
+                           WRITE (nout,*) 'Trop de point proches ', ja, jot, jo_tab
+                           STOP
+                        ELSE
+                           jo_nb = jo_nb + 1
+                           z_d_1 = z_d_1 + xosrft (jo2)
+                           jo_tab (jo_nb) = jo2
+                        END IF
+                     END IF
+                     ! Calcul du poids
+                  END DO SeekOce_4_2
+                  IF (jo_nb == 0) THEN
+                     WRITE (nout,*) 'Pas de voisin au voisin ! ', ja, jot, m2oi(jot), m2oj(jot), xolont(jot), xolatt(jot)
+                     WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+                     WRITE (nout,*) r_earth * REAL (geodist (xolont (jot), xolatt (jot), xolont (jot), xolatt (jot)), KIND=rl)
+                     STOP
+                  ELSE
+!-$$                  WRITE(nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja), jot, jo_nb, jo_tab (1:jo_nb)
+                     DO jn = 1, jo_nb
+                        jo3 = jo_tab (jn)
+                        IF (nvo (jo3) < jpa2o ) THEN ! Reste un poids libre
+                           nvo (jo3) = nvo (jo3) + 1
+                           wa2o (nvo (jo3), jo3) = xosrft (jo3) / z_d_1
+                           ka2o (nvo (jo3), jo3) = ja
+                           !$$$                     WRITE (nout,*) '  Vers point oce ', jot, m2oi(jot), m2oj(jot), nvo(jot)
+                        ELSE
+                           WRITE(nout,*) '  Plus de place ', ja, jo3, nvo (jo3), z_d_1
+                           STOP
+                        ENDIF
+                     END DO
+                  END IF
+               ELSE
+                  WRITE (nout,*) 'Pas de voisins proche trouve '
+                   WRITE (nout,*) 'Point atm ', ja, m2ai(ja), m2aj(ja)
+                  WRITE (nout,*) dist_max, zzmin, z_d_1
+                  STOP
+               END IF Trouve_4_1
+            END DO SeekAtm_4_1
+            !!
+            CALL verif ('Ltotal_dist_3 avant gather')
+            CALL bilan ("Ltotal_dist_3 avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_3 avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Ltotal_dist_3 avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+            CALL gather_wei ('apres total_dist_3')
+            CALL verif ( 'Cas total_dist_3')
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+            !!
+            CALL bilan ("Fin ltotal_dist_3 ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_3 ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Fin ltotal_dist_3 ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+         END IF Total_dist_3
+
+         !!
+         Essai: IF (lessai) THEN
+            WRITE (nout,*) '--- Methode essai ----'
+            no = COUNT ( laland .AND. (itarget == 0_il))
+            WRITE (nout,*) 'Nombre de points atm non vises : ', no
+            WRITE (nout,*) 'jma2o, jpa2o, jma2o+no ', jma2o, jpa2o, jma2o+no
+            IF ( jma2o + no .GT. jpa2o ) THEN
+               WRITE (nout, *) 'Pas assez de voisins pour la methode essai'
+               STOP
+            END IF
+            !! Liste des points oceans
+            no = COUNT ( looce .AND. iomskp == 0_il)
+            WRITE (nout,*) 'Nombre de points oce cibles : ', no
+            ALLOCATE ( jo_n (no), STAT=ierr) ; CALL chk_allo (ierr, 'jo_n')
+            !!
+            no = 0 ; z_d_1 = 0.0_rl
+            DO jo = 1, jpon
+               IF ( .NOT. looce (jo)   ) CYCLE
+               IF ( iomskp (jo) == 1 ) CYCLE
+               no = no + 1
+               jo_n (no) = jo
+               z_d_1 = z_d_1 + xosrft (jo)
+            END DO
+            no = COUNT ( looce .AND. iomskp == 0_il)
+            WRITE (nout,*) 'Surface : ', z_d_1
+            SeekAtm_5_1: DO ja = 1, jpan
+               IF (itarget (ja) .GE. 1_il) CYCLE SeekAtm_5_1
+               IF (iamskp  (ja) .EQ. 1_il) CYCLE SeekAtm_5_1
+               IF (.NOT. laland (ja) ) CYCLE SeekAtm_5_1
+               DO kn = 1, no
+                  jo = jo_n (kn)
+                  IF (nvo (jo) < jpa2o ) THEN ! Reste un poids libre
+                     nvo (jo) = nvo (jo) + 1
+                     wa2o (nvo (jo), jo) = xosrft (jo) / z_d_1
+                     ka2o (nvo (jo), jo) = ja
+                  ELSE 
+                     WRITE(nout,*) '  Plus de place ', ja, jot, nvo (jot), z_d_1
+                     STOP
+                  ENDIF
+               END DO
+            END DO SeekAtm_5_1
+            !! 
+            CALL gather_wei ('apres essai')
+            !!
+            CALL verif ( 'Cas essai')
+            CALL bilan ("Lessai avant gather ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Lessai avant gather ", c_case="terre100", c_int_atm="Integral", c_int_oce="Integral")
+            CALL bilan ("Lessai avant gather ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Integral")
+            !!
+            WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+         END IF Essai
+         !!
+         !! Traitement des points atmosphere en bord de cote
+         !!
+!-$$      IfNear: IF (lnear) THEN
+!-$$         WRITE (nout,*) 'Extension de 1 point a l''interieur, vers le point ocean le plus proche (lnear=TRUE)'
+!-$$         SeekAtm1: DO ja = 1, jpan
+!-$$            IF (.NOT. laland_bord(ja) ) CYCLE SeekAtm1
+!-$$            IF (iamskp(ja) .EQ. 1_il ) CYCLE SeekAtm1
+!-$$            IF (.NOT. laland(ja) ) CYCLE SeekAtm1
+!-$$            zzmin = REAL (geodist(0.0_rl, 90.0_rl, 0.0_rl, -90.0_rl), KIND=rl)
+!-$$            ltrouve = .FALSE. ; jot = 0_il
+!-$$            SeekOce1: DO jo = 1, jpon
+!-$$               IF (.NOT. locot(jo) ) CYCLE SeekOce1
+!-$$               IF (iomskp(jo) .EQ. 1_il ) CYCLE SeekOce1
+!-$$               z_d_1 =  REAL (geodist(xalont(ja), xalatt(ja), xolont(jo), xolatt(jo)), KIND=rl)
+!-$$               IF (z_d_1 .LT. zzmin) THEN 
+!-$$                  zzmin = z_d_1
+!-$$                  ltrouve = .TRUE. ; jot = jo
+!-$$               END IF
+!-$$            ENDDO SeekOce1
+!-$$            Trouve11: IF (ltrouve) THEN
+!-$$               WRITE (nout,*) 'Point oce proche ', jot, m2oi(jot), m2oj(jot)
+!-$$               !! Calcul du poids
+!-$$               z_d_1 = xasrft(ja)/xosrft(jot)
+!-$$               !! Rangement des poids
+!-$$               ! On cherche si ce point atm est deja vise par ce point ocean (normalement non)
+!-$$               ltrouve2 = .FALSE.
+!-$$               L11: DO jn = 1, jpa2o
+!-$$                  IF (ka2o(jn,jot) == ja ) THEN
+!-$$                     wa2o(jn,jot) =  wa2o(jn,jot) + z_d_1
+!-$$                     WRITE (nout,*) 'Ajout au point oce ', jo, m2oi(jo), m2oj(jo)
+!-$$                     ltrouve2 = .TRUE.
+!-$$                     EXIT L11
+!-$$                  ENDIF
+!-$$               ENDDO L11
+!-$$               Trouve12: IF (.NOT. ltrouve2 ) THEN
+!-$$                  IF (nvo(jot) < jpa2o ) THEN ! Reste un poids libre
+!-$$                     nvo(jot) = nvo(jot) + 1
+!-$$                     wa2o(nvo(jot),jot) = z_d_1
+!-$$                     ka2o(nvo(jot),jot) = ja
+!-$$                     WRITE (nout,*) 'Vers point oce ', jot, m2oi(jot), m2oj(jot)
+!-$$                  ELSE ! Trouve2
+!-$$                     WRITE(nout,*) 'Plus de place'
+!-$$                     STOP
+!-$$                  ENDIF
+!-$$               END IF Trouve12
+!-$$            ELSE ! Trouve
+!-$$               !! Message d'erreur
+!-$$               WRITE (unit = nout, fmt = '("Pas de voisin proche pour ", 1I5,2I4)' ) ja, m2ai(ja), m2aj(ja)
+!-$$            END IF Trouve11
+!-$$         END DO SeekAtm1
+!-$$         !!
+!-$$         CALL verif ( 'Cas Near' )
+!-$$         !!
+!-$$         WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+!-$$         !!
+!-$$      END IF IfNear
+         !!
+!-$$      IfNei: IF (lnei) THEN
+!-$$         WRITE(nout,*) 'Route le run-off vers les autres voisins mouilles (lnei=TRUE)'
+!-$$         i2a = 0_il
+!-$$         WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) i2a = 1_il
+!-$$         SeekAtm2: DO ja = 1_il, jpan
+!-$$            IF (.NOT. laland_bord(ja) ) CYCLE SeekAtm2
+!-$$            IF (iamskp(ja) .EQ. 1_il ) CYCLE SeekAtm2
+!-$$            IF (.NOT. laland(ja) ) CYCLE SeekAtm2
+!-$$            !! Nombre de voisins
+!-$$            jai = m2ai(ja) ; jaj = m2aj(ja) ! Indices 2D
+!-$$            jai_p = mai(jai+1_il) ; jai_m = mai(jai-1_il)
+!-$$            jaj_p = maj(jaj+1_il) ; jaj_m = maj(jaj-1_il)
+!-$$            inum =  &
+!-$$               &   i2a (jai_p, jaj  ) &
+!-$$               & + i2a (jai_m, jaj  ) & 
+!-$$               & + i2a (jai  , jaj_p) &
+!-$$               & + i2a (jai  , jaj_m) &
+!-$$               & + i2a (jai_p, jaj_p) & 
+!-$$               & + i2a (jai_p, jaj_m) &  
+!-$$               & + i2a (jai_m, jaj_p) &  
+!-$$               & + i2a (jai_m, jaj_m) 
+!-$$            IF (inum == 0) WRITE(nout,*) "erreur ", ja 
+!-$$            !!
+!-$$            IF (i2a(jai_p, jaj  ) == 1_il ) CALL complet_run (m1a(jai_p, jaj  ), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_m, jaj  ) == 1_il ) CALL complet_run (m1a(jai_m, jaj  ), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai  , jaj_p) == 1_il ) CALL complet_run (m1a(jai  , jaj_p), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai  , jaj_m) == 1_il ) CALL complet_run (m1a(jai  , jaj_m), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_p, jaj_p) == 1_il ) CALL complet_run (m1a(jai_p, jaj_p), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_p, jaj_m) == 1_il ) CALL complet_run (m1a(jai_p, jaj_m), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_m, jaj_p) == 1_il ) CALL complet_run (m1a(jai_m, jaj_p), m1a(jai,jaj), inum)
+!-$$            IF (i2a(jai_m, jaj_m) == 1_il ) CALL complet_run (m1a(jai_m, jaj_m), m1a(jai,jaj), inum)
+!-$$         END DO SeekAtm2
+!-$$         !!
+!-$$         CALL verif ('Cas Nei')
+!-$$         !!
+!-$$         WRITE (unit = nout, fmt = * ) 'Nombre de voisins apres completion : ', jma2o
+!-$$         !!
+!-$$      END IF IfNei
+         !!
+         CALL int_wei
+         !!
+         !! Controle
+         !! 
+         CALL verif (' Normalisation')
+         !!
+         CALL bilan ("Apres lcoast ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Local")
+         CALL bilan ("Apres lcoast ", c_case="terre100", c_int_atm="Integral", c_int_oce="Local")
+         CALL bilan ("Apres lcoast ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Local")
+         !!
+         WRITE (unit = nout, fmt = * ) 'Nombre de voisins : ', jma2o
+         !!
+         CALL gather_wei ('apres normalisation')
+         CALL verif ('apres gather' )
+
+         !! Atm mask interpolated to oce
+         za = REAL (1_il-iamskt, KIND = rl )
+         CALL inter_a2o (za, a2omask )
+         !! 1 on Atm interpolated to oce
+         za = REAL (1_il       , KIND = rl )
+         CALL inter_a2o (za, a2ofull )
+
+         !!
+         !! Checking weights
+         WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9  )' ) &
+            &  MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+         WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9  )' ) &
+            &  MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+         jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1)
+         joi = m2oi(jo)  ;  joj = m2oj(jo)
+         WRITE (unit = nout, fmt = '("Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+            & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+         jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1)
+         joi = m2oi(jo) ; joj = m2oj(jo)
+         WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+            & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+         !
+         jind(1:1) = INT(MAXLOC (nvo),il) ; jo = jind(1)
+         WRITE (unit = nout, fmt = *) jo, m2oi(jo), m2oj(jo), ka2o(1:nvo(jo),jo), &
+            & (m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo)), jn = 1, nvo(jo))
+         !!
+         clweight =  "WEIGHTS4" ; cladress = "ADRESSE4"
+         WRITE (unit = nout, fmt = *) cladress, " ", clweight, " ", jpa2o, jma2o
+         !!
+         !! Controle
+         !! 
+         WRITE (nout, *) 'Verif avant ecriture'
+         WRITE (nout, *) 'wa2o ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+         WRITE (nout, *) 'ka2o ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+         WRITE (nout, *) 'xasrft ', MINVAL (xasrft), MAXVAL (xasrft)
+         WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+         WRITE (nout, *) 'xosrft ', MINVAL (xosrft), MAXVAL (xosrft)
+         WRITE (nout, *) 'iomskt ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+         WRITE (nout, *) 'iomskp ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+         WRITE (nout, *) 'iamskt ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+         WRITE (nout, *) 'locot ', COUNT (locot)
+         WRITE (nout, *) 'lacot ', COUNT (lacot)
+         !!
+      ENDIF L_LCOAST
+      !!
+   END IF E_DRYRUN
+   !!
+   !!
+   WRITE (nout, *) ' '
+   WRITE (nout, *) ' '
+   WRITE (nout, *) 'Eventuels traitement specifiques'
+   WRITE (nout, *) ' '
+   WRITE (nout, *) ' '
+
+
+   !! Extension ??
+
+   !! Traitements specifiques, tres specifiques ... !!
+   IF ( TRIM(c_suffix) == "_runoffNord09" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord09'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.9
+      END DO
+   END IF
+   !
+   IF ( TRIM(c_suffix) == "_runoffNord07" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord07'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.7
+      END DO
+   END IF
+
+   IF ( TRIM(c_suffix) == "_runoffNord00" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord00'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.0
+      END DO
+   END IF
+   !!
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2or /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule / lu : ', jma2o, jma2or
+      !STOP
+   ENDIF
+   !!
+   !! Ecriture des poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+   !
+   IF ( l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.runoff.i" // TRIM(c_i) // ".r" // TRIM(c_r) // TRIM(c_suffix)
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i_4 a -> o: ', TRIM(cfname4)
+   END IF
+   !
+   IF (l_wei_i8) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM(mo_name) // ".wa2o.runoff.i" // TRIM(c_i) // ".r" // TRIM(c_r) // TRIM(c_suffix)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i_8  a -> o : ', TRIM(cfname8)
+   END IF
+   !
+   cldiag_a2o = TRIM(a2o_name) // '.runcoa.diag' 
+   clw_a2o    = TRIM(mo_name)  // '.wa2o.runcoa'
+   clw_a2o_mct= TRIM(mo_name)  // '.wa2o_mct.runcoa'
+   !
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "4", l_fulldiag, lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE., &
+      & co_omsk=TRIM(cotes_omsk), co_amsk=TRIM(cotes_amsk) )         
+   !
+   IF (lriv) THEN
+      !! Dataset 3 : cas particulier du run off des rivieres
+      !!
+      ka2o = 0 ;  wa2o = 0.0e0_rl ; nvo = 0 ; nva = 0 ; jma2o = 1
+      OPEN (unit = nriv, file = '/home/clim/ocean/CPL/DATA/riviere.dat', status = 'old', action = 'read', &
+         & form = 'formatted', position = 'rewind' )
+      jovoid = 1
+      DO jr = 1, jpr
+         READ (unit = nriv, fmt = '(1A1,2I3,1I5,1A30)' ) clriv, joi, joj, nlmd, clname
+         clname = ADJUSTL (TRIM (ADJUSTL (clname)))
+         jai = m2ai (nlmd) ; jaj = m2aj (nlmd)
+         jaj = jpaj - jaj + 1
+         ja = m1a(jai,jaj)
+         IF (joi == 99 .AND. joj == 99 ) THEN
+            !! On ramene sur la ligne j=1 de l'ocean pour faire un bilan plus tard
+            jovoid = jovoid + 1
+            WRITE (unit = nout, fmt = &
+               & '(1A, " (", 1A30, ") ", 1I3, " : ", 4I5, " : ", 2F6.1 )' ) &
+               & clriv, clname, jr, nlmd, ja, jai, jaj, xalont (ja), xalatt (ja)
+            joi = jovoid ; joj = 1
+            jo = m1o (joi, joj)
+            nva (ja) = nva (ja) + 1
+            nvo (jo) = nvo (jo) + 1
+            ka2o (nvo (jo), jo) = ja
+            wa2o (nvo (jo), jo) = 1.0e0_rl
+         ELSE
+            jo = m1o (joi, joj)
+            nva (ja) = nva (ja) + 1
+            nvo (jo) = nvo (jo) + 1
+            ka2o (nvo (jo), jo) = ja
+            IF (lint_atm .AND. lint_oce ) THEN
+               !! Atm envoie : kg.s-1, Oce reçoit : kg.s-1
+               wa2o(nvo(jo),jo) = 1.0e0_rl
+            ELSE
+               !! Atm envoie kg/m ^2/s. Oce reçoit kg/m^2/s
+               wa2o (nvo (jo), jo) = xasrft (ja) / xosrft (jo)
+            END IF
+            WRITE (unit = nout, fmt = &
+               & '(1A, " (", 1A30, ") ", 1I3, " : ", 4I5, " -> ", 2I4, 1I2, " : ", 1E12.4, "  ", 2F6.1, " -> ", 2F6.1)' ) &
+               & clriv, clname, jr, nlmd, ja, jai, jaj, joi, joj, nvo(jo), wa2o (nvo(jo),jo), xalont(ja), xalatt(ja), &
+               & clo_lon(xolont(jo),xalont(ja)), xolatt (jo)
+         END IF
+      END DO
+      CLOSE (unit = nriv)
+      jma2o = MAXVAL (nvo)
+      WRITE (unit = nout, fmt = '("Voisins atm                 : ", 2I9  )' ) &
+         &  MINVAL(nva), MAXVAL(nva)
+      WRITE (unit = nout, fmt = '("Voisins ocean               : ", 2I9  )' ) &
+         &  MINVAL(nvo), MAXVAL(nvo)
+      WRITE (unit = nout, fmt = '("Point bidons                : ", 2I9  )' ) jovoid
+      !!
+   END IF
+
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2or /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule / lu : ', jma2o, jma2or 
+      !STOP
+   ENDIF
+   !!
+   !! Ecriture des poids
+   !!
+   !! Ouverture des fichiers poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+   !
+   IF (l_wei_i4) THEN
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.rivflu"  // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i4 a -> o: ', TRIM(cfname4)
+   END IF
+   !
+   IF (l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM (mo_name) // ".wa2o.rivflu" // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i8  a -> o : ', TRIM(cfname8)
+   END IF
+
+   !
+   cldiag_a2o  = TRIM (a2o_name) // '.rivflu.diag' 
+   clw_a2o     = TRIM (mo_name)  // '.wa2o.rivflu'
+   clw_a2o_mct = "rmp_"//TRIM(camod_t)//"_to_"//TRIM(comod_t)//"_MOSAIC_rivflu"
+   !
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "3", l_fulldiag, lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE., &
+      &  co_omsk='noperio', co_amsk='full' )
+
+   !!
+   IF (l_wei_i4) CLOSE (unit = nwei8a2o)
+   IF (l_wei_i8) CLOSE (unit = nwei4a2o)
+   !!
+   WRITE (nout,*) 'Appel flioclo'
+   CALL flioclo
+   !!
+   STOP
+   !!
+CONTAINS
+   !!
+   SUBROUTINE diag_itarget (clmess, lwrite)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      LOGICAL, INTENT (in) :: lwrite
+      INTEGER, SAVE :: nappel = 0
+      CHARACTER (len=2) :: cc
+      !!
+      nappel = nappel + 1
+      !! 
+      itarget = 0_il ; wtarget = 0.0_rl
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo) 
+            IF (ja /= 0 ) THEN
+               itarget (ja) = itarget (ja) + 1_il
+               wtarget (ja) = wtarget (ja) + wa2o (jn, jo)
+            ENDIF
+         END DO
+      END DO
+      !!
+      !CALL lbc (itarget, naperio, 'T', jpai, jpaj)
+      !CALL lbc (wtarget, naperio, 'T', jpai, jpaj)
+      !!
+      IF (lwrite) THEN 
+         !$$$      WRITE(nout,*) 'itarget, etape '// clmess
+         !$$$      CALL prihin (RESHAPE(itarget,(/jpai,jpaj/)),1_il,nout)
+         WRITE (unit = cc, fmt = '(1I2.2)' ) nappel
+         CALL fliodefv (nid_it, 'itarget'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_it, 'ntarget'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_it, 'wtarget'    // cc, (/1, 2/), v_t=flio_r4)
+         CALL fliodefv (nid_it, 'non_target' // cc, (/1, 2/), v_t=flio_i4)
+
+
+         CALL flioputa (nid_it, 'itarget' // cc, 'long_name ', clmess // ' itarget' // cc)
+         CALL flioputv (nid_it, 'itarget' // cc, MIN (1, RESHAPE (itarget, (/jpai, jpaj/))) )
+
+         CALL flioputa (nid_it, 'ntarget' // cc, 'long_name ', clmess // ' ntarget' // cc)
+         CALL flioputv (nid_it, 'ntarget' // cc, RESHAPE (itarget, (/jpai, jpaj/)) )
+
+         CALL flioputa (nid_it, 'wtarget' // cc, 'long_name ', clmess // ' wtarget' // cc)
+         CALL flioputv (nid_it, 'wtarget' // cc, RESHAPE (wtarget, (/jpai, jpaj/)) )
+
+         wtarget = 0
+         WHERE (itarget .EQ. 0 .AND. (laland .OR. lacot)) wtarget = 1.0_rl
+         CALL flioputa (nid_it, 'non_target' // cc, 'long_name ', clmess // ' non_target' // cc)
+         CALL flioputv (nid_it, 'non_target' //cc, RESHAPE (NINT (wtarget), (/jpai, jpaj/)) )
+      END IF
+      !!
+   END SUBROUTINE diag_itarget
+   !!
+   SUBROUTINE int_wei
+      !!
+      IMPLICIT NONE
+      WRITE(nout,*) 'Debut normalisation'
+      !!
+      IF (.NOT. lint_atm) THEN
+         WRITE(nout,*) 'Multiplication par les surfaces atm'
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               ja = ka2o (jn, jo)
+               IF (ja > 0 ) wa2o (jn,jo) = wa2o (jn,jo) * xasrft (ja)
+            END DO
+         ENDDO
+      ENDIF
+      !!
+      IF (.NOT. lint_oce) THEN
+         WRITE (nout,*) 'Division par les surfaces oce'
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               wa2o (jn,jo) = wa2o (jn,jo) / xosrft (jo)
+            END DO
+         ENDDO
+      ENDIF
+   END SUBROUTINE int_wei
+   !!
+   SUBROUTINE complet_run (ka1, ka2, kn)
+      INTEGER (kind=il), INTENT(in) :: ka1, ka2 ! Index of atm boxes
+      INTEGER (kind=il), INTENT(in) :: kn ! Number of neighbors
+      INTEGER (kind=il) :: jt
+      !!
+      DO jo = 1, jpon
+         IF (iomskt(jo) == 1 ) CYCLE
+         IF (iomskp(jo) .EQ. 1_il ) CYCLE
+         DO jn = 1, jpa2o
+            IF (ka2o(jn,jo) == ka1 ) THEN
+               nvo(jo) = nvo(jo)+1
+               IF (nvo(jo) > jpa2o ) THEN
+                  WRITE(nout,*) 'Pas assez de voisins pour la completion '
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1)' ) ka1, m2ai(ka1), m2aj(ka1), &
+                     &   xalont(ka1), xalatt(ka1)
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1)' ) ka2, m2ai(ka2), m2aj(ka2), &
+                     &   xalont(ka2), xalatt(ka2)
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1,2I8)') jo, m2oi(jo), m2oj(jo), &
+                     &   xolont(jo), xolatt(jo), jn, nvo(jo)
+                  DO jt = 1, jpa2o
+                     WRITE(nout,fmt=*) jt, ka2o(jt,jo), xalont(ka2o(jt,jo)), xalatt(ka2o(jt,jo)), &
+                        & lacot(ka2o(jt,jo))
+                  ENDDO
+               END IF
+               ka2o (nvo (jo), jo) = ka2
+               wa2o (nvo (jo), jo) = wa2o(jn,jo) * xasrft(ka2) / xasrft(ka1) / REAL(kn,KIND=rl)
+            END IF
+         END DO
+      ENDDO
+   END SUBROUTINE complet_run
+   !!
+   SUBROUTINE gather_wei (clmess)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER (kind=il) :: jn1, jn2, jo2
+      !! Eliminate redundancy
+      DO jo = 1, jpon
+         DO jn1 = 1, jpa2o-1
+            IF (ka2o (jn1,jo) == 0 ) CYCLE
+            DO jn2 = jn1+1, jpa2o
+               IF (ka2o (jn1, jo) == ka2o (jn2, jo) ) THEN 
+                  WRITE(nout,*) 'Redondance ', jo, jn1, jn2, ka2o(jn1,jo), ka2o (jn2,jo), wa2o(jn1,jo), wa2o(jn2,jo)
+                  wa2o (jn1, jo) = wa2o (jn1, jo) + wa2o (jn2, jo)
+                  ka2o (jn2, jo) = 0
+               END IF
+            END DO
+         END DO
+      END DO
+      !!
+      !! Seek for strangeness
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo)
+            IF (ja == 0) CYCLE
+            IF (wa2o (jn, jo) == 0.0E0 ) THEN 
+               WRITE (nout, *) 'Null weight : ', jo, jn, ja, locot (jo), lacot (ja)
+            END IF
+         END DO
+      END DO
+      !!
+      !! Periodicity
+      !DO jn = 1, jpa2o
+      !   CALL lbc (wa2o (jn,:), noperio, 'T', jpoi, jpoj)
+      !   CALL lbc (ka2o (jn,:), noperio, 'T', jpoi, jpoj)
+      !END DO
+      CALL diag_itarget (' gather/perio - ' // clmess, lwrite=.TRUE.)
+      !!
+      !! Gather weights
+      DO jo = 1, jpon
+         ktemp = ka2o (:,jo) ; wtemp = wa2o (:,jo)
+         ka2o (:,jo) = 0_il  ; wa2o (:,jo) = 0.0_rl
+         kn = 1_il
+         DO jo2 = 1, jpa2o
+            IF (ktemp (jo2) /= 0_il ) THEN
+               ka2o (kn, jo) =  ktemp (jo2)
+               wa2o (kn, jo) =  wtemp (jo2)
+               kn = kn + 1_il
+            END IF
+         END DO
+      END DO
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !
+      !!
+      !! Periodicity
+      !DO jn = 1, jpa2o
+      !   CALL lbc (wa2o(jn,:), noperio, 'T', jpoi, jpoj)
+      !   CALL lbc (ka2o(jn,:), noperio, 'T', jpoi, jpoj)
+      !END DO
+      !!
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !!
+   END SUBROUTINE gather_wei
+   !!
+   SUBROUTINE verif (clmess, l_non_a)
+      !!
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER :: ja
+      LOGICAL, INTENT (in), OPTIONAL :: l_non_a
+      !!
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      CALL diag_itarget (clmess, lwrite=.TRUE.)
+      !!
+      WRITE (nout, *) ' --- Verifs -- : ', TRIM (clmess)
+      WRITE (nout, *) 'wa2o    ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+      WRITE (nout, *) 'ka2o    ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+      WRITE (nout, *) 'xasrft  ', MINVAL (xasrft), MAXVAL (xasrft)
+      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+      WRITE (nout, *) 'xosrft  ', MINVAL (xosrft), MAXVAL (xosrft)
+      WRITE (nout, *) 'iomskt  ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+      WRITE (nout, *) 'iomskp  ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+      WRITE (nout, *) 'iamskt  ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+      WRITE (nout, *) 'locot   ', COUNT (locot)
+      WRITE (nout, *) 'lacot   ', COUNT (lacot)
+      WRITE (nout, *) 'Points non attribues : ', COUNT (itarget .EQ. 0 .AND. (laland .OR. lacot))
+
+      IF (PRESENT (l_non_a)) THEN 
+         DO ja = 1, jpan
+            IF (itarget (ja) == 0 .AND. iamskp(ja) == 0 .AND. (laland (ja) .OR. lacot(ja) )) THEN
+!-$$               WRITE (UNIT=nout,FMT='("Point atm non attribues : ", 3I7, 2F7.1, 1I4)' ) ja, m2ai(ja), m2aj (ja), xalont(ja), xalatt(ja), itarget(ja)
+               WRITE (nout,*) ja, m2ai(ja), m2aj (ja), xalont(ja), xalatt(ja), itarget(ja), laland(ja), lacot(ja), laoce(ja)
+            ENDIF
+         END DO
+      END IF
+   END SUBROUTINE verif
+   !!
+   !! 
+   SUBROUTINE noroute
+      !! Determine les points atmospheres non routes
+      lanoroute = .TRUE.
+
+      DO jn = 1, jpa2o
+         DO jo = 1, jpon
+            ja = ka2o ( jo, jn)
+            IF ( ja /= 0 .AND. wa2o (jo,jn) > 0.0_rl ) THEN
+               lanoroute = .FALSE.
+            END IF
+         END DO
+      END DO
+
+   END SUBROUTINE noroute
+   !!
+   SUBROUTINE bilan (clmess, c_case, c_int_atm, c_int_oce)
+      !!
+      CHARACTER (len=*), INTENT (in) :: clmess
+      CHARACTER (len=*), INTENT (in) :: c_case ! Type de champ d'entree
+      CHARACTER (len=*), INTENT (in) :: c_int_atm ! Type d'integrale sur l'atm
+      CHARACTER (len=*), INTENT (in) :: c_int_oce ! Type d'integrale sur l'ocean
+      !!
+      WRITE (nout,*) "Bilan :" // TRIM (clmess) // ", cas :", TRIM (c_case), ", c_int_atm :", TRIM (c_int_atm),&
+         &   ", c_int_oce :", TRIM(c_int_oce), "."
+      !!
+      za = 0.0_rl
+      !!
+      SELECT CASE (TRIM (c_case))
+      CASE ('complet')
+         za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft)
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE ('terre')
+         WHERE (laland .OR. lacot)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft 
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft*(1.0-o2amask))
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE ('terre100')
+         WHERE (laland)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft 
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft)
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE ('ocean')
+         WHERE (lacot)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+         CASE default
+            WRITE (nout,*) TRIM(clmess), ' : Erreur type de bilan atm'  ; STOP
+         END SELECT
+         !!
+      CASE ('cote')
+         WHERE (lacot)
+            za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+         END WHERE
+         SELECT CASE (TRIM (c_int_atm))
+         CASE ('Integral')
+            za = za * xasrft
+            zsuma = SUM (za)
+         CASE ('Local')
+            zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+         CASE default
+            WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+         END SELECT
+         !!
+      CASE default
+         WRITE (nout,*)'Erreur choix de cas' ; STOP
+         STOP
+      END SELECT
+      !!
+      CALL inter_a2o (za, zo)
+      !!
+      SELECT CASE (TRIM (c_int_oce))
+      CASE ('Integral')
+         zsumo = DOT_PRODUCT (zo, REAL(1-iomskp, KIND=rl))
+      CASE ('Local')
+         zsumo = DOT_PRODUCT (zo*xosrft,REAL(1-iomskp, KIND=rl))
+      CASE default
+         WRITE (nout,*) TRIM (clmess), ' : Erreur type de bilan ' ; STOP
+      END SELECT
+      !!
+      WRITE (nout, fmt='("  bilan atm: ", 1E15.6, ", bilan oce: ", 1E15.6)' ) zsuma, zsumo
+      !!
+      RETURN
+      !!
+   END SUBROUTINE bilan
+   !!
+END PROGRAM cote
+
Index: /TOOLS/MOZAIC/src/MOZAIC/cotes_a.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/cotes_a.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/cotes_a.f90	(revision 3326)
@@ -0,0 +1,214 @@
+! -*- Mode: f90 -*-
+MODULE mod_cotes_a
+CONTAINS
+   SUBROUTINE cotes_a
+      !>
+      !! Compute weights by exact by distance
+      !!
+      USE declare
+      USE modeles
+      USE math
+      USE formula
+      USE mod_proj
+      USE mod_polom
+      USE mod_lbc
+      !!
+      IMPLICIT NONE
+      !!
+
+      REAL (kind=rp) :: zg !> Distance of boxes 
+      REAL (kind=rp), DIMENSION (:), ALLOCATABLE :: xat_p, yat_p
+
+      INTEGER (kind=il) :: kproj = 2 !> Type of projection
+      INTEGER (kind=il) :: ja, jo, jo2, jai, jaj, joi, joj, jn, nto, no !> Dummy indexes
+      LOGICAL (kind=il) :: lwrite  !> For test outputs
+      INTEGER (kind=il) :: ld = 1 , ld_t !> Debug flag
+      INTEGER (kind=il) :: np=0 ! Comptage de print
+      REAL (kind = rl) :: xoloninf, xolonsup, yolatinf, yolatsup
+      REAL (kind = rl) :: xaloninf, xalonsup, yalatinf, yalatsup
+      REAL (kind=rl) :: dx, dy
+      INTEGER (kind=il) :: kerr_p(jpai+1) !> Error code of projection
+      !!
+      !! Generation of weights
+      !!
+      ! Initialisation
+      nto = 0
+      jma2o = 0 ; wa2o = zero ; ka2o = 0 ; nvo = 0
+      nborda = 0 ; nbordo = 0
+      wasum = 0.0_rl ; wosum = 0.0_rl
+      WRITE (unit = nout, fmt = *)
+      WRITE ( unit = nout, fmt = *) 'Number of points to compute : ', jpan
+      !!
+      dx = MAXVAL ( ABS (xae-xaw))
+      dy = MAXVAL ( ABS (yan-yas))
+      WRITE(nout,*) 'cotes_a : dx, dy : ', dx, dy
+      !
+      AtmosJ: DO jaj = 1, jpaj ! Loop over atmospheric grid points
+         ja = m1a (1, jaj)
+         AtmosI: DO jai = 1, jpai
+            ja = m1a (jai, jaj)
+            ld_t = ld
+            lwrite = .FALSE. 
+            no = 0
+            IF (ld_t <= 1 .AND. MOD(ja,100) .EQ. 0 ) THEN
+               WRITE (UNIT=nout, FMT='(1I8," ")', ADVANCE='no') ja
+               np = np + 1
+               IF (np > 15 ) THEN
+                  WRITE (UNIT=nout, FMT='(" ")') 
+                  CALL FLUSH(nout)                  
+                  np=0
+               END IF
+            ENDIF
+            xalonsup = MAXVAL (xa_ed(ja,1:jpae))
+            xaloninf = MINVAL (xa_ed(ja,1:jpae)) 
+            yalatsup = MAXVAL (ya_ed(ja,1:jpae))
+            yalatinf = MINVAL (ya_ed(ja,1:jpae))
+
+!-$$            IF (iamskt (ja) == 1 .AND. .NOT. lmaska) THEN ! This point is not considered
+!-$$               IF (ld_t >= 2)  WRITE ( nout, fmt ='("Atm rejected (Atm masked)",1I6,2I4)' ) ja, jai, jaj
+!-$$               CYCLE  AtmosI
+!-$$            END IF
+
+!-$$            IF ( iamskt (ja) == 1 .AND. .NOT. lacot(ja) ) THEN ! This point is not considered
+!-$$               IF (ld_t >= 2)  WRITE ( nout, fmt ='("Atm rejected (Atm masked)",1I6,2I4)' ) ja, jai, jaj
+!-$$               CYCLE  AtmosI
+!-$$            END IF
+!-$$
+
+            IF ( laoce (ja) ) THEN ! This point is not considered
+               IF (ld_t >= 2)  WRITE ( nout, fmt ='("Atm rejected (Atm masked)",1I6,2I4)' ) ja, jai, jaj
+               CYCLE  AtmosI
+            END IF
+            
+            IF ( iamskp (ja) .EQ. 1 ) THEN  ! Periodicity point rejected
+               IF ( ld_t >= 4 ) WRITE (nout, fmt ='("Atm rejected (Atm perio)",1I6,2I4)' ) ja, jai, jaj
+               CYCLE AtmosI
+            END IF
+
+            IF ( yalatsup .GT. 89.9 .OR. yalatinf .LT. - 89.9 ) THEN ! Pole rejected
+               IF ( ld_t >= 4 ) WRITE (nout, fmt ='("Atm rejected (Atm pole)",1I6,2I4)' ) ja, jai, jaj
+               CYCLE AtmosI
+            END IF
+
+            IF ( dist_coast_a(ja) .GT. dist_max_atm ) THEN  ! Point too far from coast rejected
+               IF ( ld_t >= 4 ) WRITE (nout, fmt ='("Atm rejected (Atm far from coast)",1I6,2I4)' ) ja, jai, jaj
+               CYCLE AtmosI
+            END IF
+
+            IF (ld_t >= 2)  WRITE ( nout, fmt ='("Working on atm : ", 1I6,2I4,6F8.1,2I2)' ) &
+               & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), xaloninf, xaloninf, yalatinf, yalatsup, iamskt (ja), iamskp (ja)
+
+!-$$            IF ( xaloninf > xo_sup+dx .OR. xalonsup < xo_inf-dx ) THEN ! This point is not considered
+!-$$               IF (ld_t >= 2)  WRITE ( nout, fmt ='("Atm rejected (Atm point outside oce latitude limits )",1I6,2I4,2F8.1)' ) &
+!-$$                  & ja, jai, jaj, yalatinf, yalatsup 
+!-$$               CYCLE  AtmosI
+!-$$            END IF
+!-$$            IF ( yalatinf > yo_sup+dy .OR. yalatsup < yo_inf-dy ) THEN ! This point is not considered
+!-$$               IF (ld_t >= 2)  WRITE ( nout, fmt ='("rejected (Atm point outside oce longitude limits)",1I6,2I4,2F8.1)' ) &
+!-$$                  &ja, jai, jaj, xaloninf, xaloninf
+!-$$               CYCLE  AtmosI
+!-$$            END IF
+    
+            !!
+            OceanJ: DO joj = 1, jpoj !! Boucle sur les points oceaniques
+               jo = m1o ( 1, joj) 
+               OceanI: DO joi = 1, jpoi
+                  jo = m1o ( joi, joj) 
+                  !!
+                  ! Masked point
+                  IF ( iomskt (jo) .EQ. 1 .AND. .NOT. lmasko) THEN
+                     IF (ld_t >= 4) WRITE (nout, fmt ='("Oce rejected (Oce masked)",2(1I6,2I4))') ja, jai, jaj, jo, joi, joj
+                     IF (ld_t >= 4) WRITE (nout, fmt ='("Oce rejected (mask ) : ",2(1I6,2I4,2F8.1,1F8.4))') & 
+                        & ja, jai, jaj, jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe)
+                     CYCLE OceanI
+                  END IF
+                  
+                  ! Periodicity
+                  IF (iomskp (jo) .EQ. 1 ) THEN  ! Periodicity point rejected
+                     IF (ld_t >= 4) WRITE ( nout, fmt ='("Oce rejected (Oce perio) : ",2(1I6,2I4,2F8.1,1F8.4))') &
+                        & ja, jai, jaj,jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe)
+                     CYCLE OceanI
+                  END IF
+                  !
+                  !! Rejet point trop loin de la cote
+                  IF ( dist_coast_o(jo) .GT. dist_max_oce ) THEN  ! Point too far from coast rejected
+                     IF ( ld_t >= 4 ) WRITE (nout, fmt ='("Oce rejected (Oce far from coast)",1I6,2I4)' ) jo, joi, joj
+                     CYCLE OceanI
+                  END IF
+                  !
+                  ld_t = ld
+                  !
+                  !IF (ld_t <= 1) THEN
+                  !   WRITE (UNIT=nout, FMT='("jo=",1I8," ")', ADVANCE='no') jo
+                  !   CALL FLUSH(nout)
+                  !ENDIF
+                  !
+                  xolonsup = MAXVAL(xo_ed(jo,:))
+                  xoloninf = MINVAL(xo_ed(jo,:)) 
+                  yolatsup = MAXVAL(yo_ed(jo,:))
+                  yolatinf = MINVAL(yo_ed(jo,:)) 
+                  IF ( yolatsup > 85.0_rl ) yolatsup = 90.0_rl
+                  !IF ( joj == jpoj-1 .AND. yolatsup > 87.0_rl .AND. yalatsup > 85.0_rl) ld_t = 3
+
+               
+                  !! Geographical distance criterion
+                  zg = ra * geodist (xa_ed(ja,jpae), ya_ed(ja,jpae), xo_ed(jo,jpoe), yo_ed(jo,jpoe))
+                  IF ( zg .GE. dist_max_oce+dist_max_atm  ) THEN ! Boxes not close enough
+                     IF (ld_t >= 4) WRITE (nout, fmt ='("Oce rejected (geodist) : ",2(1I6,2I4,2F8.1),1E14.3)') & 
+                        & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), &
+                        & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), &
+                        & zg
+                     CYCLE OceanI
+                  END IF
+                  
+                  IF (ld_t >= 2) WRITE ( nout, fmt ='("Oce accepted (final) : ",2(1I6,2I4,2F8.1),3(1PE13.4))') &
+                     & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), &
+                     & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), &
+                     & zg
+            
+                  !
+                  
+                  IF (nvo (jo) >= jpa2o ) THEN
+                     WRITE (unit = nout, fmt = '("Not enough atm neighbors in : ", 2I6, 1I7, 7F8.1)' ) &
+                        &  joi, joj, nvo(jo), xolont(jo), xolatt(jo), yolatinf, yolatsup, zg
+                     WRITE (unit = nout, fmt = *) jai, jaj, nva(ja), xa_ed(ja,jpae), ya_ed(ja,jpae), yalatinf, yalatsup
+                     WRITE (unit = nout, fmt = "('xa_ed : ', 4F10.2)" ) xa_ed(ja,:)
+                     WRITE (unit = nout, fmt = *)  'ya_ed : ', ya_ed(ja,:)
+                     WRITE (unit = nout, fmt = *)  'xo_ed : ', xo_ed(ja,:)
+                     WRITE (unit = nout, fmt = *)  'yo_ed : ', yo_ed(ja,:)
+                     STOP
+                     EXIT OceanI
+                  ENDIF
+                  nvo (jo) = nvo (jo) + 1
+                  jma2o = MAX (jma2o, nvo (jo))
+                  ka2o (nvo(jo), jo) = ja
+                  wa2o (nvo(jo), jo) = xasrft(ja) / xosrft(jo)
+
+                  wasum (ja) = wasum(ja) +  wa2o (nvo(jo), jo)
+                  wosum (jo) = wosum(jo) +  wa2o (nvo(jo), jo)
+                  
+                  !!
+                  no = no + 1
+                  !
+               END DO OceanI
+            END DO OceanJ
+            nto = no + nto 
+         END DO AtmosI
+      END DO AtmosJ
+      !!
+      WRITE ( nout, fmt = *) ' '
+      WRITE ( nout, fmt = '("Total points : ", 1I6 , ", Average : ", 1F9.3, " oce points per atm point" )' ) &
+         & nto, REAL(nto,KIND=rl) / REAL(jpan,KIND=rl)
+      !!
+      
+      jma2o = MAXVAL (nvo)
+      jma2o = MIN (jma2o, jpa2o)
+      
+      !!
+      WRITE (nout, fmt = *) jpa2o, jma2o, jpo2a, jmo2a
+      !!
+      CLOSE (unit = 36)
+      CLOSE (unit = 37)
+      !!
+   END SUBROUTINE cotes_a
+END MODULE mod_cotes_a
Index: /TOOLS/MOZAIC/src/MOZAIC/cotes_etal.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/cotes_etal.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/cotes_etal.f90	(revision 3326)
@@ -0,0 +1,1109 @@
+! -*- Mode: f90 -*-
+PROGRAM cotes_etal
+   USE declare
+   USE modeles
+   USE mod_lecdata
+   USE formula
+   USE math
+   USE mod_cotes_a
+   USE mod_rectifie
+   USE mod_lbc
+   USE mod_norma
+   USE bords
+   USE mod_inter
+   USE mod_prih
+   USE mod_wri_wei
+   USE mod_inipar
+   USE fliocom
+   USE getincom
+   USE errioipsl
+!!!
+   IMPLICIT NONE
+!!!
+!!!   A partir d'un fichier de poids, complete avec les rivieres et
+!!!   les poids pour le run off
+   !! On met a zero les poids sur les points non cotiers, et on renormalise
+   !!
+   INTEGER (kind=il), PARAMETER :: jpr = 52 ! Nombre de rivieres
+   REAL (kind=rl) :: zsuma, zsumo
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: za
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zo
+   !!
+   CHARACTER (LEN = 1) :: clriv
+   CHARACTER (LEN = 30) :: clname
+   INTEGER (kind=il) :: ja, jo, jo2, jo3, jn, jno, joi, joj, jai, jaj, jr, kn  ! indices de boucle
+   INTEGER (kind=il) :: jai_p, jai_m, jaj_p, jaj_m, n1
+   INTEGER (kind=il) :: joi_p, joi_m, joj_p, joj_m
+   REAL (kind=rl) :: z_d_1, z_d_2, zzmin
+   INTEGER (kind=il) :: nriv = 32, nlmd = 35
+   INTEGER (kind=il), DIMENSION (:, :), ALLOCATABLE :: jx ! Point trouve sous une maille atm
+   INTEGER (kind=il) :: kom, ko, niter, nc
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: la_temp, lo_temp
+   REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: wtemp
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: ktemp2
+   REAL(kind=rl), DIMENSION (:,:), ALLOCATABLE  :: wtemp2
+   !INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: iamsk
+   !INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: iomsk
+   INTEGER (kind=il) :: jovoid, jot, inum
+   CHARACTER (len=80) :: cfname4, cfname8
+   LOGICAL :: ltrouve, ltrouve2
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: itarget, idest
+   REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: wtarget, wdest
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: i2a, i2o
+   INTEGER (kind=il) :: no, ntrouve
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: jo_n
+   LOGICAL :: l_fulldiag = .TRUE.
+   CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: tmask_atl, tmask_noclose, tmask_nomed, tmask_med
+   REAL(kind=rl), DIMENSION (:, :), ALLOCATABLE  :: z2o
+   CHARACTER (len=40) :: cl_bassin
+   INTEGER (kind=il) :: il_ncid
+   !!
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   INTEGER (kind=il) :: ierr
+   !!
+   INTEGER :: nid_it, nid_id
+   !!
+   CHARACTER (len = 50) :: cldiag_a2o, clw_a2o, clw_a2o_cdf, clw_a2o_mct
+   CHARACTER (len = 25) :: mo_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   CALL inipar
+   CALL alloc_modeles
+
+   !!
+   ALLOCATE (za      (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'za', lreset=.TRUE., crout='cotes')
+   ALLOCATE (zo      (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'zo')
+   ALLOCATE (jx      (jpa2o,2)   , STAT=ierr) ; CALL chk_allo (ierr, 'jx')
+   !
+   ALLOCATE (lacot   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'lacot')  ; lacot  = .FALSE.
+   ALLOCATE (laland  (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'laland') ; laland = .FALSE.
+   ALLOCATE (laoce   (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'laoce')  ; laoce  = .FALSE.
+   !
+   ALLOCATE (locot   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'locot')  ; locot  = .FALSE.
+   ALLOCATE (looce   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'looce')  ; looce  = .FALSE.
+   ALLOCATE (lo_nearcoast(jpon)  , STAT=ierr) ; CALL chk_allo (ierr, 'lonearcoast')  ; looce  = .FALSE.
+   ALLOCATE (la_nearcoast(jpan)  , STAT=ierr) ; CALL chk_allo (ierr, 'lanearcoast')  ; looce  = .FALSE.
+   !
+   ALLOCATE (ktemp   (jpa2o)     , STAT=ierr) ; CALL chk_allo (ierr, 'ktemp')
+   ALLOCATE (wtemp   (jpa2o)     , STAT=ierr) ; CALL chk_allo (ierr, 'wtemp')
+   ALLOCATE (dist_coast_o (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'dist_coast_o')
+   ALLOCATE (dist_coast_a (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'dist_coast_a')
+   !
+   ALLOCATE (itarget (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'itarget')
+   ALLOCATE (wtarget (jpan)      , STAT=ierr) ; CALL chk_allo (ierr, 'wtarget')
+   ALLOCATE (i2a     (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'i2a')
+   !
+   ALLOCATE (idest   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'idest')
+   ALLOCATE (wdest   (jpon)      , STAT=ierr) ; CALL chk_allo (ierr, 'wdest')
+   ALLOCATE (i2o     (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'i2o')
+   !
+   ALLOCATE (tmask_atl     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_atl')
+   ALLOCATE (tmask_noclose (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_noclose')
+   ALLOCATE (tmask_nomed   (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmasl_nomed')
+   ALLOCATE (tmask_med     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_med')
+   ALLOCATE (z2o (jpoi, jpoj), STAT=ierr)     ; CALL chk_allo (ierr, 'z2o')
+   !
+   IF (l_limit_iosize) l_fulldiag = .FALSE.
+   !!
+   !! Initialisation
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13 ; nchk = 14 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 81 ; nwei8o2a = 82 ; nwei4a2o = 83 ; nwei8a2o = 84
+   !
+   nout = 6
+   IF (nout /= 6 .AND. nout /= 0 ) &
+      & OPEN (unit = nout, file = 'cote' // TRIM(c_suffix) // '.out', action = 'WRITE', status = 'unknown', position = 'REWIND' )
+   !!
+   !! Diagnostics files
+   !!
+   IF (nout /= 6 ) &
+      &  OPEN (unit = nout, file = 'cotes' // TRIM(c_suffix) // '.out', position = 'REWIND', action = 'WRITE', status = 'replace' )
+   !!
+   !! Read coordinates of all models, and weights
+   !!
+   CALL lecdata (lecweights = .FALSE., leco2amask = .TRUE. )
+
+   !! Lecture masques de bassin
+   IF ( TRIM (cotyp) == 'orca4' .OR. &
+      & TRIM (cotyp) == 'orca2' .OR. TRIM (cotyp) == 'orca2.0' .OR. TRIM (cotyp) == 'orca2.1' .OR. TRIM (cotyp) == 'orca2.3' .OR. &
+      & TRIM (cotyp) == 'orca1' &
+      & ) THEN 
+      !cl_bassin = TRIM (cotyp) 
+      cl_bassin = TRIM(c_basins)
+!-$$      IF (c_period /= 'none' ) cl_bassin = TRIM (cl_bassin) // TRIM (c_period)
+      WRITE (nout,*) 'Reading bassin masks in : ', TRIM (cl_bassin)
+      CALL flioopfd (TRIM (cl_bassin), il_ncid )
+      CALL fliogetv (il_ncid, 'mask_atl'    , z2o )
+      tmask_atl = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_noclose', z2o )
+      tmask_noclose = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_nomed'  , z2o )
+      tmask_nomed = RESHAPE (z2o, (/ jpon /) )
+      CALL flioclo (il_ncid)
+   ELSE
+      tmask_atl     = REAL (1-iomskt, rl)
+      tmask_noclose = REAL (1-iomskt, rl)
+      tmask_nomed   = REAL (1-iomskt, rl)
+   END IF
+   !
+   WRITE (unit=nout, fmt=*) 'iomskt'
+   CALL prihin (RESHAPE(iomskt             ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_atl'
+   CALL prihin (RESHAPE(NINT(tmask_atl)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_med'
+   !CALL prihin (RESHAPE(NINT(tmask_med)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_noclose'
+   !CALL prihin (RESHAPE(NINT(tmask_noclose),(/jpoi,jpoj/)), 1_il, nout)
+   !
+   WRITE (nout,*) "iamskt"
+   iamskt = 0
+   WHERE (o2amask .LT. epsfrac) iamskt = 1
+   CALL prihin (RESHAPE(iamskt,(/jpai,jpaj/)), 1, nout)
+   
+   ! Set correct periodicity to grids
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+   CALL lbc (xalont, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalonu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalonv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !!
+   CALL rectifie
+   !!
+   CALL fliocrfd ('itarget' // TRIM(c_suffix), (/'x', 'y'/), (/jpai, jpaj/), nid_it, mode='REPLACE')
+   CALL flioputa (nid_it, "?", "title"         , "itarget" )
+   CALL flioputa (nid_it, '?', 'Comment', TRIM(c_comment) )
+   CALL DATE_AND_TIME (c_date, c_time, c_zone )
+   CALL flioputa (nid_it, "?", "history"       , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"// &
+      & c_date(7:8)//" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) )
+   CALL flioputa (nid_it, "?", "method"        , "MOSAIC" )
+   CALL flioputa (nid_it, "?", "source_grid"   , "curvilinear" )
+   CALL flioputa (nid_it, "?", "dest_grid"     , "curvilinear" )
+   CALL flioputa (nid_it, "?", "Institution"   , "IPSL" )
+   CALL flioputa (nid_it, "?", "Model"         , "IPSL CM6" )
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME", VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_it, "?", "HOSTNAME"     , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $HOSTNAME'
+   END IF
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_it, "?", "LOGNAME"      , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $LOGNAME'
+   END IF
+
+   CALL fliodefv (nid_it, 'laland'      , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'lacot'       , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'laoce'       , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'la_nearcoast' , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'dist_coast_a' , (/1,2/), v_t=flio_r4)
+   
+   CALL fliodefv (nid_it, 'lon', (/1, 2/), units="degree_north", v_t=flio_r4 )
+   CALL fliodefv (nid_it, 'lat', (/1, 2/), units="degree_east",  v_t=flio_r4 )
+   CALL fliodefv (nid_it, 'o2amask', (/1,2/), v_t=flio_r4)
+   CALL fliodefv (nid_it, 'iamskt', (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_it, 'iamskp', (/1,2/), v_t=flio_i4)
+
+   CALL flioputv (nid_it, 'lon'    , RESHAPE ( xalont, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'lat'    , RESHAPE ( xalatt, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'o2amask', RESHAPE (o2amask, (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'iamskt' , RESHAPE (iamskt , (/jpai, jpaj/)) )
+   CALL flioputv (nid_it, 'iamskp' , RESHAPE (iamskp , (/jpai, jpaj/)) )
+   !!
+
+   !!
+   CALL fliocrfd ('idest' // TRIM(c_suffix), (/'x', 'y'/), (/jpoi, jpoj/), nid_id, mode='REPLACE')
+   CALL flioputa (nid_id, "?", "title"         , "idest" )
+   CALL flioputa (nid_id, '?', 'Comment', TRIM(c_comment) )
+   CALL DATE_AND_TIME (c_date, c_time, c_zone )
+   CALL flioputa (nid_id, "?", "history"       , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"// &
+      & c_date(7:8)//" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) )
+   CALL flioputa (nid_id, "?", "method"        , "MOSAIC" )
+   CALL flioputa (nid_id, "?", "source_grid"   , "curvilinear" )
+   CALL flioputa (nid_id, "?", "dest_grid"     , "curvilinear" )
+   CALL flioputa (nid_id, "?", "Institution"   , "IPSL" )
+   CALL flioputa (nid_id, "?", "Model"         , "IPSL CM6" )
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME", VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_id, "?", "HOSTNAME"     , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $HOSTNAME'
+   END IF
+   CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=ierr)
+   IF ( ierr == 0 ) THEN
+      CALL flioputa (nid_id, "?", "LOGNAME"      , TRIM(c_tmp) )
+   ELSE 
+      WRITE (nout,*) 'Environment variable not found : $LOGNAME'
+   END IF
+
+   CALL fliodefv (nid_id, 'locot'       , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_id, 'looce'       , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_id, 'lo_nearcoast' , (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_id, 'dist_coast_o' , (/1,2/), v_t=flio_r4)
+   
+   CALL fliodefv (nid_id, 'lon', (/1, 2/), units="degree_north", v_t=flio_r4 )
+   CALL fliodefv (nid_id, 'lat', (/1, 2/), units="degree_east",  v_t=flio_r4 )
+   CALL fliodefv (nid_id, 'iomskt', (/1,2/), v_t=flio_i4)
+   CALL fliodefv (nid_id, 'iomskp', (/1,2/), v_t=flio_i4)
+
+   CALL flioputv (nid_id, 'lon'    , RESHAPE ( xolont, (/jpoi, jpoj/)) )
+   CALL flioputv (nid_id, 'lat'    , RESHAPE ( xolatt, (/jpoi, jpoj/)) )
+   CALL flioputv (nid_id, 'iomskt' , RESHAPE (iamskt , (/jpoi, jpoj/)) )
+   CALL flioputv (nid_id, 'iomskp' , RESHAPE (iamskp , (/jpoi, jpoj/)) )
+  
+   !!
+   !! Compute edges of grid boxes
+   !!
+   CALL bord_a
+   CALL bord_o
+   CALL bord_oa
+   !!
+   mo_name  = "mozaic"
+   a2o_name = "a2o"
+   !!
+   WRITE (nout,*) 'Calculs points terre/oce/cote sur grille atmosphere'
+   WHERE (o2amask .LT. epsfrac                                     ) laland = .TRUE.
+   WHERE (o2amask .GE. epsfrac .AND. o2amask .LE. (1.0_rl-epsfrac) ) lacot  = .TRUE.
+   WHERE (                           o2amask .GT. (1.0_rl-epsfrac) ) laoce  = .TRUE.
+   !!
+   WRITE (UNIT=nout, FMT=*) 'Points cotiers ', COUNT(lacot)
+   WRITE (nout,*) 'lacot '
+   CALL prihbo (RESHAPE(lacot, (/jpai, jpaj/)), nout, l_norsud=.FALSE.)
+   
+   WRITE (nout,*) 'Ecriture '
+   i2a = 0
+   WHERE (RESHAPE(laland,(/jpai,jpaj/))) i2a=1
+   CALL flioputv (nid_it, "laland", i2a)
+   i2a = 0
+   WHERE (RESHAPE(laoce ,(/jpai,jpaj/))) i2a=1
+   CALL flioputv (nid_it, "laoce", i2a)
+   i2a = 0
+   WHERE (RESHAPE(lacot ,(/jpai,jpaj/))) i2a=1
+   CALL flioputv (nid_it, "lacot", i2a)
+   !!
+   WRITE (nout,*) 'Determination des points cotes ocean '
+   locot = .FALSE.
+   looce = .FALSE.
+   DO jo = 1, jpon
+      IF ( iomskt (jo) == 0_il .AND. iomskp (jo) == 0_il ) THEN
+         joi = moi (jo) ; joj = moj (jo) ! Indices 2D
+         joi_p = MIN(joi+1, jpoi) ; joi_m = MAX (joi-1, 1)
+         joj_p = MIN(joj+1, jpoj) ; joj_m = MAX (joj-1, 1)
+         IF (    iomskt (m1o (joi_p, joj  )) == 1  &
+            .OR. iomskt (m1o (joi_m, joj  )) == 1  &
+            .OR. iomskt (m1o (joi  , joj_p)) == 1  &
+            .OR. iomskt (m1o (joi  , joj_m)) == 1  &
+            .OR. iomskt (m1o (joi_p, joj_p)) == 1  &
+            .OR. iomskt (m1o (joi_p, joj_m)) == 1  &
+            .OR. iomskt (m1o (joi_m, joj_p)) == 1  &
+            .OR. iomskt (m1o (joi_m, joj_m)) == 1  ) THEN
+            locot (jo) = .TRUE.
+         ELSE 
+            looce (jo) = .TRUE.
+         END IF
+      END IF
+   END DO
+   CALL lbc (locot, noperio, 'T', jpoi, jpoj)
+   CALL lbc (looce, noperio, 'T', jpoi, jpoj)
+
+   i2o = 0
+   WHERE (RESHAPE(locot,(/jpoi,jpoj/))) i2o=1
+   CALL flioputv (nid_id, "locot", i2o)
+   i2o = 0
+   WHERE (RESHAPE(looce,(/jpoi,jpoj/))) i2o=1
+   CALL flioputv (nid_id, "looce", i2o)
+   
+   WRITE (nout,*) 'locot '
+   CALL prihbo (RESHAPE(locot, (/jpoi, jpoj/)), nout, l_norsud=.FALSE.)
+
+   !!
+   !! Determination d'une bande cotiere atm
+   la_nearcoast = lacot
+   ALLOCATE (la_temp(jpan), STAT=ierr) ; CALL chk_allo (ierr, 'la_temp')
+   DO niter = 1, 5
+      la_temp = la_nearcoast
+      DO ja = 1, jpan
+         IF ( iamskt(ja) == 1_il .AND. iamskp (ja) == 0_il ) THEN
+            jai = mai (ja) ; jaj = maj (ja) ! Indices 2D
+            jai_p = MIN(jai+1, jpai) ; jai_m = MAX (jai-1, 1)
+            jaj_p = MIN(jaj+1, jpaj) ; jaj_m = MAX (jaj-1, 1)
+            IF (    la_temp (m1a (jai_p, jaj  ))  &
+               .OR. la_temp (m1a (jai_m, jaj  ))  &
+               .OR. la_temp (m1a (jai  , jaj_p))  &
+               .OR. la_temp (m1a (jai  , jaj_m))  &
+               .OR. la_temp (m1a (jai_p, jaj_p))  &
+               .OR. la_temp (m1a (jai_p, jaj_m))  &
+               .OR. la_temp (m1a (jai_m, jaj_p))  &
+               .OR. la_temp (m1a (jai_m, jaj_m))  ) THEN
+               la_nearcoast (ja) = .TRUE.
+            END IF
+         END IF
+      END DO
+      CALL lbc (la_nearcoast, naperio, 'T', jpai, jpaj)
+   END DO
+
+   WRITE (nout,*) 'la_nearcoast '
+   CALL prihbo (RESHAPE(la_nearcoast, (/jpai, jpaj/)), nout, l_norsud=.TRUE.)
+   i2a = 0
+   WHERE (RESHAPE(la_nearcoast ,(/jpai,jpaj/))) i2a=1
+   CALL flioputv (nid_it, "la_nearcoast", i2a)
+   
+   !!
+   !! Determination d'une bande cotiere ocean
+   lo_nearcoast = locot
+   ALLOCATE (lo_temp(jpon), STAT=ierr) ; CALL chk_allo (ierr, 'lo_temp')
+   DO niter = 1, 8
+      lo_temp = lo_nearcoast
+      DO jo = 1, jpon
+         IF ( iomskt(jo) == 0 .AND. iomskp (jo) == 0_il ) THEN
+            joi = moi (jo) ; joj = moj (jo) ! Indices 2D
+            joi_p = MIN(joi+1, jpoi) ; joi_m = MAX(joi-1, 1)
+            joj_p = MIN(joj+1, jpoj) ; joj_m = MAX(joj-1, 1)
+            IF (    lo_temp (m1o (joi_p, joj  ))  &
+               .OR. lo_temp (m1o (joi_m, joj  ))  &
+               .OR. lo_temp (m1o (joi  , joj_p))  &
+               .OR. lo_temp (m1o (joi  , joj_m))  &
+               .OR. lo_temp (m1o (joi_p, joj_p))  &
+               .OR. lo_temp (m1o (joi_p, joj_m))  &
+               .OR. lo_temp (m1o (joi_m, joj_p))  &
+               .OR. lo_temp (m1o (joi_m, joj_m))  ) THEN
+               lo_nearcoast (jo) = .TRUE.
+            END IF
+         END IF
+      END DO
+      CALL lbc (lo_nearcoast, noperio, 'T', jpoi, jpoj)
+   END DO
+
+   WRITE (nout,*) 'lo_nearcoast '
+   CALL prihbo (RESHAPE(lo_nearcoast, (/jpoi, jpoj/)), nout, l_norsud=.FALSE.)
+   i2o = 0
+   WHERE (RESHAPE(lo_nearcoast ,(/jpoi,jpoj/))) i2o=1
+   CALL flioputv (nid_id, "lo_nearcoast", i2o)
+   
+   !!
+   WRITE (nout,*) 'Distance a la cote - points atmosphere'
+   DO ja = 1, jpan
+      dist_coast_a (ja) = rpi * ra
+      IF ( MOD(ja, 1000) .EQ. 0 ) WRITE (nout,*) ja, '/', jpan
+      IF ( iamskt (ja) .EQ. 0 ) THEN
+         dist_coast_a (ja) = 0.0E0_rl
+         CYCLE
+      END IF
+      IF ( .NOT. la_nearcoast (ja) ) THEN
+         dist_coast_a (ja) = 2.0_rl * dist_max_atm
+         CYCLE
+      END IF
+      DO jo = 1, jpon
+         IF ( locot(jo) ) THEN
+            dist_coast_a (ja) = MIN ( dist_coast_a (ja), &
+               & ra * geodist ( xalont(ja), xalatt(ja), xolont(jo), xolatt(jo) ) )
+         END IF
+      END DO
+   END DO
+   CALL lbc ( dist_coast_a, naperio, 'T', jpai, jpaj )
+   CALL prihre (RESHAPE(dist_coast_a, (/jpai,jpaj/)), 1.0E-4, nout, l_norsud=.TRUE.)
+
+   CALL flioputv (nid_it, "dist_coast_a", RESHAPE(dist_coast_a, (/jpai,jpaj/)))
+   !!
+   WRITE (nout,*) 'Distance a la cote - point ocean'
+   DO jo = 1, jpon
+      IF ( MOD(jo, 5000) .EQ. 0 ) WRITE (nout,*) jo, '/', jpon
+      dist_coast_o (jo) =  rpi * ra
+      IF ( iomskt (jo) .EQ. 1 ) THEN
+         dist_coast_o (jo) = 0.0E0_rl
+         CYCLE
+      END IF
+      IF ( .NOT. lo_nearcoast (jo) ) THEN
+         dist_coast_o (jo) = 2.0_rl * dist_max_oce
+         CYCLE
+      END IF
+      
+      DO jo2 = 1, jpon
+         IF (  locot(jo2) ) THEN
+            dist_coast_o (jo) = MIN ( dist_coast_o (jo), &
+               & ra * geodist ( xolont(jo), xolatt(jo), xolont(jo2), xolatt(jo2) ) )
+         END IF
+      END DO
+   END DO
+   CALL lbc ( dist_coast_a, naperio, 'T', jpoi, jpoj )
+   CALL prihre (RESHAPE(dist_coast_o, (/jpoi,jpoj/)), 1.0E-4, nout)
+
+   CALL flioputv (nid_id, "dist_coast_o", RESHAPE(dist_coast_o, (/jpoi,jpoj/)))
+   
+   WRITE (nout,*) 'Verif coherence (tout doit etre nul)'
+   WRITE (nout,*) COUNT ( laland .AND. lacot)
+   WRITE (nout,*) COUNT ( lacot  .AND. laoce)
+   WRITE (nout,*) COUNT ( laoce  .AND. laland)
+   WRITE (nout,*) COUNT ( .NOT. ( laland .OR. lacot .OR. laoce) )
+
+
+
+   !!
+   WRITE (unit = nout, fmt = *) 'Nombre de points cotes atmosphere : ', COUNT (lacot)
+   WRITE (unit = nout, fmt = *) 'Nombre de points cotes ocean      : ', COUNT (locot)
+   !!
+   CALL bilan ("Avec cote ", c_case="complet", c_int_atm="Integral", c_int_oce="Integral")
+   CALL bilan ("Avec cote ", c_case="ocean"  , c_int_atm="Integral", c_int_oce="Integral")
+   CALL bilan ("Avec cote ", c_case="cote"   , c_int_atm="Integral", c_int_oce="Integral")
+
+
+   E_DRYRUN: IF (l_dryrun) THEN
+      WRITE (nout,*) "Remplissage bidon des champs pour tester les I/O"
+      jma2o = jma2or
+      nvo = jma2or
+      WRITE (nout,*) 'jma2o pour test : ', jma2o
+      CALL RANDOM_SEED
+      CALL RANDOM_NUMBER (wa2o) ; ka2o = NINT (wa2o*REAL(jpan,rl) )
+      
+      DO jo = 1, jpon
+         IF ( iomskt (jo) == 1 ) THEN
+            wa2o (:, jo) = 0.0_rl
+            ka2o (:, jo) = 0_il
+         END IF
+      END DO
+      
+      DO jo = 1, jpon
+         DO jno = 1, jpa2o
+            ja = ka2o (jno, jo)
+            IF (ja > 0) THEN 
+               IF (iamskt (ja) == 1) THEN
+                  wa2o (jno, jo) = 0.0_rl ; ka2o (jno, jo) = 0_il
+               END IF
+            END IF
+         END DO
+      END DO
+   ELSE
+      
+      CALL cotes_a
+
+      WRITE (nout, *) 'Renormalization'
+!-$$      RenormA : DO ja = 1, jpan
+!-$$         z_d_1 = 0.0e0_rl
+!-$$         kom = 0
+!-$$         RenormO : DO jo = 1, jpon
+!-$$            DO jn = 1, jpa2o
+!-$$               IF ( ka2o (jn,jo) == ja ) THEN
+!-$$                  z_d_1 = z_d_1 + wa2o (jn,jo) 
+!-$$                  kom = kom + 1
+!-$$                  jx (kom,:) = (/ jn, jo /)
+!-$$                  !!$ WRITE (unit = nout, fmt = '(6I6,16F18.6) ') ja, jo, jn, kom, jx (kom, :), &
+!-$$                  !!$   wa2o (jn,jo), wa2o (jx (kom, 1), jx (kom, 2)), z_d_1, &
+!-$$                  !!$   xosrft (jo), xasrft (ja)
+!-$$               END IF
+!-$$            END DO
+!-$$         ENDDO RenormO
+!-$$         IF (kom /= 0 ) THEN
+!-$$            IF ( z_d_1 == 0.0_rl ) THEN
+!-$$               WRITE (nout, *) 'z_d_1 nul ', ja, xasrft (ja), lacot (ja), iamskt (ja), &
+!-$$                  & wa2o (:,ja), ka2o (:,ja)
+!-$$               STOP
+!-$$            ELSE
+!-$$               DO ko = 1, kom
+!-$$                  wa2o (jx (ko,1), jx (ko,2)) = wa2o (jx (ko,1), jx (ko,2)) / z_d_1
+!-$$               END DO
+!-$$            ENDIF
+!-$$         END IF
+!-$$      ENDDO RenormA
+      wasum = 0.0_rl
+      DO jo = 1, jpon
+         IF ( nvo(jo) /= 0) THEN
+            DO jn = 1, nvo(jo)
+               ja = ka2o (jn,jo)
+               wasum (ja) = wasum (ja) + wa2o (jn,jo)
+            END DO
+         END IF
+      END DO
+      !!
+      DO jo = 1, jpon
+         IF ( nvo(jo) /= 0 ) THEN
+            DO jn = 1, nvo(jo)
+               ja = ka2o (jn,jo)
+               IF ( wasum (ja) /= 0.0_rl ) wa2o (jn,jo) = wa2o (jn,jo) / wasum (ja) 
+            END DO
+         END IF
+      END DO
+
+      !!
+      CALL int_wei
+      !!
+      !! Controle
+      !! 
+      CALL verif (' Normalisation')
+      !!
+      CALL bilan ("Final ", c_case="terre"   , c_int_atm="Integral", c_int_oce="Local")
+      CALL bilan ("Final ", c_case="terre100", c_int_atm="Integral", c_int_oce="Local")
+      CALL bilan ("Final ", c_case="cote"    , c_int_atm="Integral", c_int_oce="Local")
+      !!
+      WRITE (unit = nout, fmt = * ) 'Nombre de voisins : ', jma2o
+      !!
+      CALL gather_wei ('apres normalisation')
+      CALL verif ('apres gather' )
+
+      !! Atm mask interpolated to oce
+      za = REAL (1_il-iamskt, KIND = rl )
+      CALL inter_a2o (za, a2omask )
+      !! 1 on Atm interpolated to oce
+      za = REAL (1_il       , KIND = rl )
+      CALL inter_a2o (za, a2ofull )
+
+      !!
+      !! Checking weights
+      WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9  )' ) &
+         &  MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+      WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9  )' ) &
+         &  MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+      jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1)
+      joi = m2oi(jo)  ;  joj = m2oj(jo)
+      WRITE (unit = nout, fmt = '("Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+         & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+      jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1)
+      joi = m2oi(jo) ; joj = m2oj(jo)
+      WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+         & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+      !
+      jind(1:1) = INT(MAXLOC (nvo),il) ; jo = jind(1)
+      WRITE (unit = nout, fmt = *) jo, m2oi(jo), m2oj(jo), ka2o(1:nvo(jo),jo), &
+         & (m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo)), jn = 1, nvo(jo))
+      !!
+      clweight =  "WEIGHTS4" ; cladress = "ADRESSE4"
+      WRITE (unit = nout, fmt = *) cladress, " ", clweight, " ", jpa2o, jma2o
+      !!
+      !! Controle
+      !! 
+      WRITE (nout, *) 'Verif avant ecriture'
+      WRITE (nout, *) 'wa2o ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+      WRITE (nout, *) 'ka2o ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+      WRITE (nout, *) 'xasrft ', MINVAL (xasrft), MAXVAL (xasrft)
+      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+      WRITE (nout, *) 'xosrft ', MINVAL (xosrft), MAXVAL (xosrft)
+      WRITE (nout, *) 'iomskt ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+      WRITE (nout, *) 'iomskp ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+      WRITE (nout, *) 'iamskt ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+      WRITE (nout, *) 'locot ', COUNT (locot)
+      !!
+      !!
+   END IF E_DRYRUN
+   !!
+   !!
+   WRITE (nout, *) ' '
+   WRITE (nout, *) ' '
+   WRITE (nout, *) 'Eventuels traitement specifiques'
+   WRITE (nout, *) ' '
+   WRITE (nout, *) ' '
+
+
+   !! Extension ??
+
+   !! Traitements specifiques, tres specifiques ... !!
+   IF ( TRIM(c_suffix) == "_runoffNord09" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord09'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.9
+      END DO
+   END IF
+   !
+   IF ( TRIM(c_suffix) == "_runoffNord07" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord07'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.7
+      END DO
+   END IF
+
+   IF ( TRIM(c_suffix) == "_runoffNord00" ) THEN
+      WRITE (nout, *) 'Traitement specifique _runoffNord00'
+      DO jo = 1, jpon
+         IF ( tmask_atl(jo) == 1 .AND. xolatt(jo) > 40.0_rl ) wa2o(:,jo) = wa2o(:,jo) * 0.0
+      END DO
+   END IF
+   !!
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2or /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule / lu : ', jma2o, jma2or
+      !STOP
+   ENDIF
+   !!
+!-$$   !! Ecriture des poids
+!-$$   !!
+!-$$   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+!-$$   !
+!-$$   IF ( l_wei_i4) THEN 
+!-$$      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+!-$$      cfname4 = TRIM(mo_name) // ".wa2o.runoff.i" // TRIM(c_i) // ".r" // TRIM(c_r) // TRIM(c_suffix)
+!-$$      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace',&
+!-$$         & action = 'write')
+!-$$      WRITE (nout, *) 'Poids i_4 a -> o: ', TRIM(cfname4)
+!-$$   END IF
+!-$$   !
+!-$$   IF (l_wei_i8) THEN 
+!-$$      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+!-$$      cfname8 = TRIM(mo_name) // ".wa2o.runoff.i" // TRIM(c_i) // ".r" // TRIM(c_r) // TRIM(c_suffix)
+!-$$      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace',&
+!-$$         & action = 'write')
+!-$$      WRITE (nout, *) 'Poids i_8  a -> o : ', TRIM(cfname8)
+!-$$   END IF
+!-$$   !
+!-$$   cldiag_a2o = TRIM(a2o_name) // '.runcoa.diag' 
+!-$$   clw_a2o    = TRIM(mo_name)  // '.wa2o.runcoa'
+!-$$   clw_a2o_mct= TRIM(mo_name)  // '.wa2o_mct.runcoa'
+!-$$   !
+!-$$   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "4", l_fulldiag, lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE., &
+!-$$      & co_omsk=TRIM(cotes_omsk), co_amsk=TRIM(cotes_amsk) )         
+!-$$   !
+
+  
+   !!
+   !! Ecriture des poids
+   !!
+   !! Ouverture des fichiers poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+   !
+   IF (l_wei_i4) THEN
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.rivflu"  // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i4 a -> o: ', TRIM(cfname4)
+   END IF
+   !
+   IF (l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM (mo_name) // ".wa2o.rivflu" // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace',&
+         & action = 'write')
+      WRITE (nout, *) 'Poids i8  a -> o : ', TRIM(cfname8)
+   END IF
+
+   !
+   cldiag_a2o  = TRIM (a2o_name) // '.rivflu.diag' 
+   clw_a2o     = TRIM (mo_name)  // '.wa2o.rivflu'
+   clw_a2o_mct = "rmp_"//TRIM(camod_t)//"_to_"//TRIM(comod_t)//"_MOSAIC_rivflu"
+   !
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "3", l_fulldiag, lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE., &
+      &  co_omsk='noperio', co_amsk='full' )
+
+   !!
+   IF (l_wei_i4) THEN
+      WRITE (nout,*) 'Fermeture poids i4'
+      CLOSE (unit = nwei8a2o)
+   END IF
+   IF (l_wei_i8) THEN
+      WRITE (nout,*) 'Fermeture poids i8 '
+      CLOSE (unit = nwei4a2o)
+   END IF
+   !!
+   WRITE (nout,*) 'Appel flioclo'
+   CALL flioclo
+   !!
+   STOP
+   !!
+CONTAINS
+   !!
+   SUBROUTINE diag_itarget (clmess, lwrite)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      LOGICAL, INTENT (in) :: lwrite
+      INTEGER, SAVE :: nappel = 0
+      CHARACTER (len=2) :: cc
+      !!
+      nappel = nappel + 1
+      !! 
+      itarget = 0_il ; wtarget = 0.0_rl
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo) 
+            IF (ja /= 0 ) THEN
+               itarget (ja) = itarget (ja) + 1_il
+               wtarget (ja) = wtarget (ja) + wa2o (jn, jo)
+            ENDIF
+         END DO
+      END DO
+      !!
+      !CALL lbc (itarget, naperio, 'T', jpai, jpaj)
+      !CALL lbc (wtarget, naperio, 'T', jpai, jpaj)
+      !!
+      IF (lwrite) THEN 
+         !$$$      WRITE(nout,*) 'itarget, etape '// clmess
+         !$$$      CALL prihin (RESHAPE(itarget,(/jpai,jpaj/)),1_il,nout)
+         WRITE (unit = cc, fmt = '(1I2.2)' ) nappel
+         CALL fliodefv (nid_it, 'itarget'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_it, 'ntarget'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_it, 'wtarget'    // cc, (/1, 2/), v_t=flio_r4)
+         CALL fliodefv (nid_it, 'non_target' // cc, (/1, 2/), v_t=flio_i4)
+
+
+         CALL flioputa (nid_it, 'itarget' // cc, 'long_name ', clmess // ' itarget' // cc)
+         CALL flioputv (nid_it, 'itarget' // cc, MIN (1, RESHAPE (itarget, (/jpai, jpaj/))) )
+
+         CALL flioputa (nid_it, 'ntarget' // cc, 'long_name ', clmess // ' ntarget' // cc)
+         CALL flioputv (nid_it, 'ntarget' // cc, RESHAPE (itarget, (/jpai, jpaj/)) )
+
+         CALL flioputa (nid_it, 'wtarget' // cc, 'long_name ', clmess // ' wtarget' // cc)
+         CALL flioputv (nid_it, 'wtarget' // cc, RESHAPE (wtarget, (/jpai, jpaj/)) )
+
+         wtarget = 0
+         WHERE (itarget .EQ. 0 ) wtarget = 1.0_rl
+         CALL flioputa (nid_it, 'non_target' // cc, 'long_name ', clmess // ' non_target' // cc)
+         CALL flioputv (nid_it, 'non_target' //cc, RESHAPE (NINT (wtarget), (/jpai, jpaj/)) )
+      END IF
+      !!
+   END SUBROUTINE diag_itarget
+   !!
+   SUBROUTINE diag_idest (clmess, lwrite)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      LOGICAL, INTENT (in) :: lwrite
+      INTEGER, SAVE :: nappel = 0
+      CHARACTER (len=2) :: cc
+      !!
+      nappel = nappel + 1
+      !! 
+      idest = 0_il ; wdest = 0.0_rl
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo) 
+            IF (ja /= 0 ) THEN
+               idest (jo) = idest  (jo) + 1_il
+               wdest (jo) = wdest  (jo) + wa2o (jn, jo)
+            ENDIF
+         END DO
+      END DO
+      !!
+      !CALL lbc (itarget, naperio, 'T', jpai, jpaj)
+      !CALL lbc (wtarget, naperio, 'T', jpai, jpaj)
+      !!
+      IF (lwrite) THEN 
+         !$$$      WRITE(nout,*) 'idest, etape '// clmess
+         !$$$      CALL prihin (RESHAPE(idest,(/jpoi,jpoj/)),1_il,nout)
+         WRITE (unit = cc, fmt = '(1I2.2)' ) nappel
+         CALL fliodefv (nid_id, 'idest'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_id, 'ndest'    // cc, (/1, 2/), v_t=flio_i4)
+         CALL fliodefv (nid_id, 'wdest'    // cc, (/1, 2/), v_t=flio_r4)
+         CALL fliodefv (nid_id, 'non_dest' // cc, (/1, 2/), v_t=flio_i4)
+
+
+         CALL flioputa (nid_id, 'idest' // cc, 'long_name ', clmess // ' idest' // cc)
+         CALL flioputv (nid_id, 'idest' // cc, MIN (1, RESHAPE (idest, (/jpoi, jpoj/))) )
+
+         CALL flioputa (nid_id, 'ndest' // cc, 'long_name ', clmess // ' ndest' // cc)
+         CALL flioputv (nid_id, 'ndest' // cc, RESHAPE (idest, (/jpoi, jpoj/)) )
+
+         CALL flioputa (nid_id, 'wdest' // cc, 'long_name ', clmess // ' wdest' // cc)
+         CALL flioputv (nid_id, 'wdest' // cc, RESHAPE (wdest, (/jpoi, jpoj/)) )
+
+         wdest = 0
+         WHERE (idest .EQ. 0 ) wdest = 1.0_rl
+         CALL flioputa (nid_id, 'non_dest' // cc, 'long_name ', clmess // ' non_dest' // cc)
+         CALL flioputv (nid_id, 'non_dest' //cc, RESHAPE (NINT (wdest), (/jpoi, jpoj/)) )
+      END IF
+      !!
+   END SUBROUTINE diag_idest
+   !!
+   !!
+   SUBROUTINE int_wei
+      !!
+      IMPLICIT NONE
+      WRITE(nout,*) 'Debut normalisation'
+      !!
+      IF (.NOT. lint_atm) THEN
+         WRITE(nout,*) 'Multiplication par les surfaces atm'
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               ja = ka2o (jn, jo)
+               IF (ja > 0 ) wa2o (jn,jo) = wa2o (jn,jo) * xasrft (ja)
+            END DO
+         ENDDO
+      ENDIF
+      !!
+      IF (.NOT. lint_oce) THEN
+         WRITE (nout,*) 'Division par les surfaces oce'
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               wa2o (jn,jo) = wa2o (jn,jo) / xosrft (jo)
+            END DO
+         ENDDO
+      ENDIF
+   END SUBROUTINE int_wei
+   !!
+   SUBROUTINE complet_run (ka1, ka2, kn)
+      INTEGER (kind=il), INTENT(in) :: ka1, ka2 ! Index of atm boxes
+      INTEGER (kind=il), INTENT(in) :: kn ! Number of neighbors
+      INTEGER (kind=il) :: jt
+      !!
+      DO jo = 1, jpon
+         IF (iomskt(jo) == 1 ) CYCLE
+         IF (iomskp(jo) .EQ. 1_il ) CYCLE
+         DO jn = 1, jpa2o
+            IF (ka2o(jn,jo) == ka1 ) THEN
+               nvo(jo) = nvo(jo)+1
+               IF (nvo(jo) > jpa2o ) THEN
+                  WRITE(nout,*) 'Pas assez de voisins pour la completion '
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1)' ) ka1, m2ai(ka1), m2aj(ka1), &
+                     &   xalont(ka1), xalatt(ka1)
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1)' ) ka2, m2ai(ka2), m2aj(ka2), &
+                     &   xalont(ka2), xalatt(ka2)
+                  WRITE(nout,fmt='(1I7,2I4,2F10.1,2I8)') jo, m2oi(jo), m2oj(jo), &
+                     &   xolont(jo), xolatt(jo), jn, nvo(jo)
+                  DO jt = 1, jpa2o
+                     WRITE(nout,fmt=*) jt, ka2o(jt,jo), xalont(ka2o(jt,jo)), xalatt(ka2o(jt,jo))
+                  ENDDO
+               END IF
+               ka2o (nvo (jo), jo) = ka2
+               wa2o (nvo (jo), jo) = wa2o(jn,jo) * xasrft(ka2) / xasrft(ka1) / REAL(kn,KIND=rl)
+            END IF
+         END DO
+      ENDDO
+   END SUBROUTINE complet_run
+   !!
+   SUBROUTINE gather_wei (clmess)
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER (kind=il) :: jn1, jn2, jo2
+      !! Eliminate redundancy
+      DO jo = 1, jpon
+         DO jn1 = 1, jpa2o-1
+            IF (ka2o (jn1,jo) == 0 ) CYCLE
+            DO jn2 = jn1+1, jpa2o
+               IF (ka2o (jn1, jo) == ka2o (jn2, jo) ) THEN 
+                  WRITE(nout,*) 'Redondance ', jo, jn1, jn2, ka2o(jn1,jo), ka2o (jn2,jo), wa2o(jn1,jo), wa2o(jn2,jo)
+                  wa2o (jn1, jo) = wa2o (jn1, jo) + wa2o (jn2, jo)
+                  ka2o (jn2, jo) = 0
+               END IF
+            END DO
+         END DO
+      END DO
+      !!
+      !! Seek for strangeness
+      DO jo = 1, jpon
+         DO jn = 1, jpa2o
+            ja = ka2o (jn, jo)
+            IF (ja == 0) CYCLE
+            IF (wa2o (jn, jo) == 0.0E0 ) THEN 
+               WRITE (nout, *) 'Null weight : ', jo, jn, ja, locot (jo)
+            END IF
+         END DO
+      END DO
+      !!
+      !! Periodicity
+      !DO jn = 1, jpa2o
+      !   CALL lbc (wa2o (jn,:), noperio, 'T', jpoi, jpoj)
+      !   CALL lbc (ka2o (jn,:), noperio, 'T', jpoi, jpoj)
+      !END DO
+      CALL diag_itarget (' gather/perio - ' // clmess, lwrite=.TRUE.)
+      CALL diag_idest   (' gather/perio - ' // clmess, lwrite=.TRUE.)
+      !!
+      !! Gather weights
+      DO jo = 1, jpon
+         ktemp = ka2o (:,jo) ; wtemp = wa2o (:,jo)
+         ka2o (:,jo) = 0_il  ; wa2o (:,jo) = 0.0_rl
+         kn = 1_il
+         DO jo2 = 1, jpa2o
+            IF (ktemp (jo2) /= 0_il ) THEN
+               ka2o (kn, jo) =  ktemp (jo2)
+               wa2o (kn, jo) =  wtemp (jo2)
+               kn = kn + 1_il
+            END IF
+         END DO
+      END DO
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !
+      !!
+      !! Periodicity
+      !DO jn = 1, jpa2o
+      !   CALL lbc (wa2o(jn,:), noperio, 'T', jpoi, jpoj)
+      !   CALL lbc (ka2o(jn,:), noperio, 'T', jpoi, jpoj)
+      !END DO
+      !!
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !!
+   END SUBROUTINE gather_wei
+   !!
+   SUBROUTINE verif (clmess, l_non_a)
+      !!
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER :: ja
+      LOGICAL, INTENT (in), OPTIONAL :: l_non_a
+      !!
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      CALL diag_itarget (clmess, lwrite=.TRUE.)
+      CALL diag_idest   (clmess, lwrite=.TRUE.)
+      !!
+      WRITE (nout, *) ' --- Verifs -- : ', TRIM (clmess)
+      WRITE (nout, *) 'wa2o    ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+      WRITE (nout, *) 'ka2o    ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+      WRITE (nout, *) 'xasrft  ', MINVAL (xasrft), MAXVAL (xasrft)
+      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+      WRITE (nout, *) 'xosrft  ', MINVAL (xosrft), MAXVAL (xosrft)
+      WRITE (nout, *) 'iomskt  ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+      WRITE (nout, *) 'iomskp  ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+      WRITE (nout, *) 'iamskt  ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+      WRITE (nout, *) 'locot   ', COUNT (locot)
+      WRITE (nout, *) 'Points non attribues : ', COUNT (itarget .EQ. 0 )
+
+      IF (PRESENT (l_non_a)) THEN 
+         DO ja = 1, jpan
+            IF (itarget (ja) == 0 .AND. iamskp(ja) == 0 .AND. (laland (ja) .OR. lacot(ja) )) THEN
+!-$$               WRITE (UNIT=nout,FMT='("Point atm non attribues : ", 3I7, 2F7.1, 1I4)' ) ja, m2ai(ja), m2aj (ja), xalont(ja), xalatt(ja), itarget(ja)
+            WRITE (nout,*) ja, m2ai(ja), m2aj (ja), xalont(ja), xalatt(ja), itarget(ja), laland(ja), lacot(ja), laoce(ja)
+         ENDIF
+      END DO
+   END IF
+END SUBROUTINE verif
+!!
+!! 
+SUBROUTINE noroute
+   !! Determine les points atmospheres non routes
+   lanoroute = .TRUE.
+
+   DO jn = 1, jpa2o
+      DO jo = 1, jpon
+         ja = ka2o ( jo, jn)
+         IF ( ja /= 0 .AND. wa2o (jo,jn) > 0.0_rl ) THEN
+            lanoroute = .FALSE.
+         END IF
+      END DO
+   END DO
+
+END SUBROUTINE noroute
+!!
+SUBROUTINE bilan (clmess, c_case, c_int_atm, c_int_oce)
+   !!
+   CHARACTER (len=*), INTENT (in) :: clmess
+   CHARACTER (len=*), INTENT (in) :: c_case ! Type de champ d'entree
+   CHARACTER (len=*), INTENT (in) :: c_int_atm ! Type d'integrale sur l'atm
+   CHARACTER (len=*), INTENT (in) :: c_int_oce ! Type d'integrale sur l'ocean
+   !!
+   WRITE (nout,*) "Bilan :" // TRIM (clmess) // ", cas :", TRIM (c_case), ", c_int_atm :", TRIM (c_int_atm),&
+      &   ", c_int_oce :", TRIM(c_int_oce), "."
+   !!
+   za = 0.0_rl
+   !!
+   SELECT CASE (TRIM (c_case))
+   CASE ('complet')
+      za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+      SELECT CASE (TRIM (c_int_atm))
+      CASE ('Integral')
+         za = za * xasrft
+         zsuma = SUM (za)
+      CASE ('Local')
+         zsuma = DOT_PRODUCT (za, xasrft)
+      CASE default
+         WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+      END SELECT
+      !!
+   CASE ('terre')
+      WHERE (laland .OR. lacot)
+         za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+      END WHERE
+      SELECT CASE (TRIM (c_int_atm))
+      CASE ('Integral')
+         za = za * xasrft 
+         zsuma = SUM (za)
+      CASE ('Local')
+         zsuma = DOT_PRODUCT (za, xasrft*(1.0-o2amask))
+      CASE default
+         WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+      END SELECT
+      !!
+   CASE ('terre100')
+      WHERE (laland)
+         za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+      END WHERE
+      SELECT CASE (TRIM (c_int_atm))
+      CASE ('Integral')
+         za = za * xasrft 
+         zsuma = SUM (za)
+      CASE ('Local')
+         zsuma = DOT_PRODUCT (za, xasrft)
+      CASE default
+         WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+      END SELECT
+      !!
+   CASE ('ocean')
+      WHERE (lacot)
+         za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+      END WHERE
+      SELECT CASE (TRIM (c_int_atm))
+      CASE ('Integral')
+         za = za * xasrft
+         zsuma = SUM (za)
+      CASE ('Local')
+         zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+      CASE default
+         WRITE (nout,*) TRIM(clmess), ' : Erreur type de bilan atm'  ; STOP
+      END SELECT
+      !!
+   CASE ('cote')
+      WHERE (lacot)
+         za = 1.0_rl * REAL (1-iamskp, KIND=rl)
+      END WHERE
+      SELECT CASE (TRIM (c_int_atm))
+      CASE ('Integral')
+         za = za * xasrft
+         zsuma = SUM (za)
+      CASE ('Local')
+         zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+      CASE default
+         WRITE (nout,*) 'Erreur type de bilan atm' ; STOP
+      END SELECT
+      !!
+   CASE default
+      WRITE (nout,*)'Erreur choix de cas' ; STOP
+      STOP
+   END SELECT
+   !!
+   CALL inter_a2o (za, zo)
+   !!
+   SELECT CASE (TRIM (c_int_oce))
+   CASE ('Integral')
+      zsumo = DOT_PRODUCT (zo, REAL(1-iomskp, KIND=rl))
+   CASE ('Local')
+      zsumo = DOT_PRODUCT (zo*xosrft,REAL(1-iomskp, KIND=rl))
+   CASE default
+      WRITE (nout,*) TRIM (clmess), ' : Erreur type de bilan ' ; STOP
+   END SELECT
+   !!
+   WRITE (nout, fmt='("  bilan atm: ", 1E15.6, ", bilan oce: ", 1E15.6)' ) zsuma, zsumo
+   !!
+   RETURN
+   !!
+END SUBROUTINE bilan
+!!
+END PROGRAM cotes_etal
+
Index: /TOOLS/MOZAIC/src/MOZAIC/data_types.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/data_types.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/data_types.f90	(revision 3326)
@@ -0,0 +1,15 @@
+MODULE data_types
+   USE defprec
+   IMPLICIT NONE
+   ! Data types
+   INTEGER, PARAMETER, PUBLIC :: rl=r_std !< Default real type in MOZAIC
+   INTEGER, PARAMETER, PUBLIC :: il=i_std !< Default integer type in MOZAIC
+   INTEGER, PARAMETER, PUBLIC :: rd=rl
+   !INTEGER, PARAMETER, PUBLIC :: rd=SELECTED_REAL_KIND(25,307) !< Quadruple precision real (if available)
+   !
+   INTEGER, PARAMETER, PUBLIC :: rk_in =r_8 !< Real type in input files (masks, grids, areas)
+   INTEGER, PARAMETER, PUBLIC :: ik_in =il  !< Integer type in input files (masks, grids, areas)
+   INTEGER, PARAMETER, PUBLIC :: rk_out=r_8 !< Real type in output file (mozaic.w)
+   INTEGER, PARAMETER, PUBLIC :: ik_out=il  !< Integer type in output file (mozaic.w)
+   !
+END MODULE data_types
Index: /TOOLS/MOZAIC/src/MOZAIC/declare.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/declare.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/declare.f90	(revision 3326)
@@ -0,0 +1,64 @@
+! -*- Mode: f90 -*-
+MODULE declare
+   !> All data types used in MOZAIC
+   USE defprec
+   USE data_types
+   USE poly_types
+   IMPLICIT NONE
+   !
+   SAVE
+   !
+   ! Useful variables for initialisation
+   REAL (kind=rl) :: zero=0.0e0_rl !< Use this to initialize data
+   REAL (kind=rl) :: zun=1.0e0_rl !< Use this to initialize data
+   !
+   REAL (kind=rl), PARAMETER, PUBLIC :: zeps   =EPSILON (1.0_rl) !< Default epsilon
+   REAL (kind=rl), PARAMETER, PUBLIC :: zeps_r4=EPSILON (1.0_r_4) !< Simple precision epsilon
+   ! 
+   REAL (kind=rl), PARAMETER, PUBLIC :: rpi = 3.1415926536_rl     !< You should recognize this one ...
+   REAL (kind=rl), PARAMETER, PUBLIC :: rad = 0.0174532925_rl     !< Conversion factor for degrees to radian
+   REAL (kind=rl), PARAMETER, PUBLIC :: dar = 57.2957795130823_rl !< Conversion factor for radian to degrees
+   !   REAL (kind=rl) :: dar = 180.0_rl / rpi
+   REAL (kind=rl), PARAMETER, PUBLIC :: r_earth = 6371229.0_rl !< Earth radius
+   !
+   INTEGER (kind=il), PUBLIC :: nout = 6 !< File number for messages
+   LOGICAL, PUBLIC :: l_d_alloc !< If TRUE, print message about array allocation
+   !
+   PUBLIC chk_allo
+   !
+CONTAINS
+   SUBROUTINE chk_allo (kerr, cname, lreset, crout)
+      !> Diagonose return code from allocate
+      INTEGER (kind=il), INTENT (in) :: kerr !< Error code from ALLOCATE
+      CHARACTER (len=*), INTENT (in) :: cname !< Brief description of the allocation
+      LOGICAL, INTENT (in), OPTIONAL :: lreset !< If true, reset error counter
+      CHARACTER (len=*), INTENT (in), OPTIONAL :: crout !< Calling routine name
+      INTEGER, SAVE :: icount !< Error counter
+      CHARACTER (len = 20), SAVE :: lcrout = 'unknown'
+      !
+      IF (PRESENT (lreset)) THEN
+         icount = 0
+      END IF
+      !
+      IF (PRESENT (crout)) THEN
+         lcrout = TRIM (crout)
+      ENDIF
+      !
+      icount = icount + 1
+      !
+      IF (kerr /= 0_il) THEN 
+         WRITE (UNIT=nout, FMT=*) 'Erreur allocation memoire '
+         WRITE (UNIT=nout, FMT=*) 'Numero d''erreur : ', kerr
+         WRITE (UNIT=nout, FMT=*) 'Message : ', cname
+         WRITE (UNIT=nout, FMT=*) 'Allocation number : ', icount
+         WRITE (UNIT=nout, FMT=*) 'Routine : ', TRIM (lcrout)
+         STOP
+      ELSE
+         IF (l_d_alloc) THEN 
+            WRITE (UNIT=nout, FMT='("Memory Allocation ", 1I3, ", variable : ", A, ", in routine : ", A)') &
+               & , icount, cname, TRIM (lcrout)
+         END IF
+      END IF
+      !
+   END SUBROUTINE chk_allo
+END MODULE declare
Index: /TOOLS/MOZAIC/src/MOZAIC/dimension.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/dimension.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/dimension.f90	(revision 3326)
@@ -0,0 +1,133 @@
+! -*- Mode: f90 -*-
+!> Module dimensions
+!!   
+MODULE dimensions
+   !!
+   USE declare
+   IMPLICIT NONE
+   SAVE
+   PUBLIC
+   !!
+   CHARACTER (len=10) :: c_period = 'none' ! or lgm, mpwp, etc ...
+   !!
+   INTEGER (kind=il)   :: jpoi  !< Dimensions ocean X
+   INTEGER (kind=il)   :: jpoj  !< Dimensions ocean Y
+   CHARACTER (len = 3) :: comod  !< Ocean model name
+   CHARACTER (len = 10) :: cotyp  !< Ocean model type
+   INTEGER (kind=il)   :: jpon   !< Global (1D) dimensions
+   !!
+   !
+   INTEGER (kind=il) :: jpoe !< Number (maxi) of edges to describe ocean box
+   !!
+   INTEGER (kind=il) :: noperio !< Periodicity of ocean grid
+   LOGICAL :: lmasko=.FALSE.  !< If TRUE, masked points of oceanic     grid (land) are considered for computing.
+   LOGICAL :: l_recalc_o = .TRUE. !< Recalcule des surfaces ocean
+   !!
+   INTEGER (kind=il) :: jpai, jpait, jpaiu, jpaiv !< Dimensions atmosphere X
+   INTEGER (kind=il) :: jpaj, jpajt, jpaju, jpajv !< Dimensions atmosphere Y
+
+   CHARACTER (LEN=80)  :: c_suffix  = 'none' ! Add a suffix to all file names
+   CHARACTER (LEN=240) :: c_comment = 'none' ! Add a comment in all NetCDF Files
+   
+   CHARACTER (len = 3) :: camod    !< Atm model name
+   CHARACTER (len = 10) :: catyp   !< Atm model type
+   !!
+   INTEGER (kind=il) :: naperio !< Periodicite de la grille atmosphere
+   LOGICAL :: lmaska=.TRUE.     !< If TRUE, masked points of atmospheric grid (land) are considered for computing.
+   LOGICAL :: la_nortop         !< If TRUE, latitude indreases with index in output files
+   LOGICAL :: l_recalc_a = .TRUE. !< Recalcule des surfaces atmospheres
+   LOGICAL :: la_pole !< IF TRUE, special handing of atmospheric pole points
+   !!
+   INTEGER (kind=il) :: jpae !< Number (maxi) of edges to describe atm box
+   !!
+   INTEGER (kind=il) :: jpan  !< Dimension of 1D atm array, T grid
+   INTEGER (kind=il) :: jpanu !< Dimension of 1D atm array, U grid
+   INTEGER (kind=il) :: jpanv !< Dimension of 1D atm array, V grid
+   !!
+   LOGICAL :: lwra2o=.TRUE. !< TRUE if atm -> oce weights/adresses are computed
+   LOGICAL :: lwro2a=.TRUE. !< TRUE if oce -> atm weights/adresses are computed
+   INTEGER (kind=il) :: norma2o=1 !< Type of normalization atm-> oce: 0: none, 1: intensive, 2: extensive
+   INTEGER (kind=il) :: normo2a=1 !< Type of normalization oce -> atm: 0: none, 1: intensive, 2: extensive
+   !!
+   INTEGER (kind=il) :: jpa2o !< Dimensions for computing weights, atm -> oce
+   INTEGER (kind=il) :: jpo2a !< Dimensions for computing weights, oce -> atm
+   !!
+   LOGICAL :: limit_stack !< If true, limit stack size in NetCDF calls, by slicing output operation
+   LOGICAL :: l_grid_cdf  !< If TRUE, read grid specification in NetCDF format
+   !! LOGICAL :: l_wei_cdf   !< if TRUE, read weights and adresses in NetCDF (Oasis 3 format)
+   LOGICAL :: l_wei_i4    !< if TRUE, write adresses in INTEGER*4
+   LOGICAL :: l_wei_i8    !< if TRUE, write adresses in INTEGER*8
+   LOGICAL :: l_wei_oasis_3   !< if TRUE, write Oasis 3 weight file
+   LOGICAL :: l_wei_oasis_mct !< if TRUE, write Oasis MCT weight file
+   LOGICAL :: l_limit_iosize !< If TRUE, don't do full diagnostics in cotes.f90
+   CHARACTER (LEN=10) :: c_read_wei = 'oasis_3'
+   CHARACTER (len=64) :: c_FlioMode   !< Flio file format
+   CHARACTER (len=3) :: c_oasis !< Oasis version
+   integer (kind=il) :: slice_size !< Slice size for writing NetCDF files
+   !!
+   LOGICAL :: locerev !< Strategie de nommage des champs ocean
+   LOGICAL :: latmrev !< Strategie de nommage des champs atmosphere
+   !!
+   INTEGER (kind=il)            :: jmo2a    !< Maximum number of found neighbors, ocean -> atmosphere
+   INTEGER (kind=il)            :: jma2o    !< Maximum number of found neighbors, atmosphere -> ocean
+   INTEGER (kind=il)            :: jma2or   !< Maximum number of found neighbors : run-off
+   INTEGER (kind=il)            :: jma2oi   !< Maximum number of found neighbors : icestream
+   !!
+   REAL (kind=rl) :: xa_inf !< Minimum value of atm longitudes
+   REAL (kind=rl) :: xa_sup !< Maximum value of atm longitudes
+   REAL (kind=rl) :: ya_inf !< Minimum value of atm latitudes
+   REAL (kind=rl) :: ya_sup !< Maximum value of atm latitudes
+   REAL (kind=rl) :: xo_inf !< Minimum value of oce longitudes
+   REAL (kind=rl) :: xo_sup !< Maximum value of oce longitudes
+   REAL (kind=rl) :: yo_inf !< Minimum value of oce latitudes
+   REAL (kind=rl) :: yo_sup !< Maximum value of oce latitudes
+   !!
+   !
+   LOGICAL :: l_fast !< Quick and dirty version, for test only
+   !!
+   LOGICAL :: l_dryrun              !< Flag for fast and dirty search
+   LOGICAL :: l_ipsldbg             !< Flag for debugging IOIPSL operations
+   INTEGER (kind=il) :: lev_dry     !< For dry run : use to test I/O
+   INTEGER (kind=il) :: ndebug=2    !< Levels of printing
+   CHARACTER (len=20) :: o2a_orien="nord_en_haut"  !< Orientation for o2a diag file
+   !!
+   !! Basins
+   CHARACTER (len=40) :: cl_atl, cl_pac, cl_noclo, cl_nomed, c_basins
+   !!
+   !! Poids run-off
+   !!
+   LOGICAL :: lriv     !< Traitement du runoff des rivières
+   LOGICAL :: lcoast   !< Traitement specifique des points cotiers
+   LOGICAL :: lint_atm !< Calcul pour run-off intégré sur la maille atm
+   LOGICAL :: lint_oce !< Calcul pour run-off intégré sur la maille oce
+   LOGICAL :: lnear    !< Route le run-off des pts atm 'proches' de la cote vers le point oce le plus proche
+   LOGICAL :: lnei     !< Si vrai, route le run-off des points atm 'proches' de la cote vers les point atmosphères mouilles les plus proches.
+   LOGICAL :: ltotal          !< Route tout les points atm vers l'oce le plus proche.
+   LOGICAL :: ltotal_dist     !< Route tout les points atm vers l'oce le plus proche, avec distance maxi
+   LOGICAL :: ltotal_dist_2   !< Route tout les point atm vers les oce cotiers le plus proche, avec distance maxi
+   LOGICAL :: ltotal_dist_3   !< Route tout les point atm vers les oce le plus proche, cotiers ou pas, avec distance maxi
+   LOGICAL :: l_etal_oce   !
+   REAL (kind=rl) :: dist_etal_oce
+   LOGICAL :: lessai          !< Cas en test
+   CHARACTER (len=20) :: cotes_omsk, cotes_amsk
+   REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: dist_coast_o, dist_coast_a
+   !
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: lacot, laland, laoce, lanoroute, la_nearcoast
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: locot, looce, lo_nearcoast
+   !
+   REAL (kind=rl) :: dist_max        = r_earth !< Earth radius
+   REAL (kind=rl) :: dist_max_atm    = 400.0E3_rl !< Max distance for searching next atm neighbours
+   REAL (kind=rl) :: dist_max_oce    = 400.0E3_rl !< Max distance for searching the ocean points
+   REAL (kind=rl) :: dist_max_large  = 400.0E3_rl !< Another max distance ...
+   LOGICAL :: l_large = .TRUE. !< @todo a commenter ...
+   !!
+   !! Poids icestream
+   !!
+   INTEGER (kind=il) :: jp_calv ! Nombre de zone de collectes
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: ylimits
+   LOGICAL :: l_calving_nomed !< Calving does not go to mediterranean sea (include Red Sea, Persian Gul)
+   LOGICAL :: l_calving_noatl !< Calving does not go to Atlantic
+   LOGICAL :: l_calving_nopac !< Calving does not go to Pacific
+   
+   !!
+END MODULE dimensions
Index: /TOOLS/MOZAIC/src/MOZAIC/formula.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/formula.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/formula.f90	(revision 3326)
@@ -0,0 +1,62 @@
+! -*- Mode: f90 -*-
+MODULE formula
+   USE declare
+   USE modeles
+CONTAINS
+   ELEMENTAL FUNCTION dedans (pa, x1, x2)  !> TRUE if one point is between to others
+      IMPLICIT NONE
+      LOGICAL :: dedans
+      REAL (kind=rl), INTENT (in) :: pa, x1, x2
+      dedans = (pa > MIN (x1, x2)) .AND. (pa <= MAX (x1, x2))
+      RETURN
+   END FUNCTION dedans
+   ! ----------------------------------------------------------------------------
+   ELEMENTAL FUNCTION dehors (pa1, pa2, x1, x2) !> TRUE if one segment is disconnected from the other
+      IMPLICIT NONE
+      LOGICAL :: dehors
+      REAL (kind=rl), INTENT (in) :: pa1, pa2, x1, x2
+      dehors = (MAX (pa1, pa2) < MIN (x1, x2)) .OR. (MIN (pa1, pa2) > MAX (x1, x2))
+      RETURN
+   END FUNCTION dehors
+   ! ----------------------------------------------------------------------------
+   ELEMENTAL FUNCTION clo_lon (zlon, zlon0) !> Find closest longitude
+      IMPLICIT NONE
+      REAL (kind=rl) :: clo_lon
+      REAL (kind=rl), INTENT (in) :: zlon, zlon0
+      REAL (kind=rl) :: zz, zp, zm, z0
+      INTEGER (kind=il) :: jn
+      z0 = zlon
+      DO jn = 1_il, 2_il
+         zz = ABS ((z0          ) - zlon0)
+         zp = ABS ((z0 + 360.0_rl) - zlon0)
+         zm = ABS ((z0 - 360.0_rl) - zlon0)
+         IF (     zp < MIN (zm, zz)) THEN 
+            z0 = z0 + 360.0_rl
+         ELSE IF (zm < MIN (zp, zz)) THEN 
+            z0 = z0 - 360.0_rl
+         END IF
+      END DO
+      clo_lon = z0
+   END FUNCTION clo_lon
+   ! ----------------------------------------------------------------------------
+   ELEMENTAL FUNCTION lon_180 (zlon) !> Set lon in [0-360]
+      REAL (kind=rl) :: lon_180
+      REAL (kind=rl), INTENT (in) :: zlon
+      REAL (kind=rl) :: z0
+      z0 = zlon
+      IF ( z0 <   0.0_rl) z0 = z0 + 360.0_rl
+      IF ( z0 > 360.0_rl) z0 = z0 - 360.0_rl
+      lon_180 = z0
+   END FUNCTION lon_180
+
+  ! ----------------------------------------------------------------------------
+!$$$  FUNCTION tri_surf (plon, plat) !> Surface of triangle on the sphere
+!$$$    USE declare
+!$$$    IMPLICIT NONE
+!$$$    REAL (kind=rl) :: tri_surf
+!$$$    REAL (kind=rl), DIMENSION (3), INTENT (in) :: plon, plat
+!$$$    tri_surf = 0.0_rl
+!$$$  END FUNCTION tri_surf
+!$$$  !! 
+END MODULE formula
+
Index: /TOOLS/MOZAIC/src/MOZAIC/icestream.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/icestream.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/icestream.f90	(revision 3326)
@@ -0,0 +1,400 @@
+! -*- Mode: f90 -*-
+PROGRAM icestream
+   USE declare
+   USE modeles
+   USE mod_lecdata
+   USE formula
+   USE math
+   USE mod_rectifie
+   USE mod_lbc
+   USE bords
+   USE mod_prih
+   USE mod_wri_wei
+   USE fliocom
+   USE errioipsl
+   USE getincom
+   USE mod_inipar
+   USE mod_inter
+!!!
+   IMPLICIT NONE
+!!!
+!!!   A partir d'un fichier de poids, complete avec les poids pour l'eau qui
+!!!   vient des calottes
+
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: ynorth, ysouth
+   REAL (kind=rl), PARAMETER :: zm_frac = 0.0_rl ! Fraction criterium
+   !!
+   INTEGER (kind=il) :: ja, jo, jn, joi, joj, jai, jaj, jr, kn ! indices de boucle
+   INTEGER (kind=il), DIMENSION (:, :), ALLOCATABLE :: imask ! Masque
+   REAL (kind=rl)    :: zosrf, zasrf ! Surface totale
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zasrf_lat ! Surface atmosphere par bande de latitude
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: wtemp
+   REAL(kind=rl), DIMENSION (:, :), ALLOCATABLE  :: z2o
+   CHARACTER (len=80) :: cfname4, cfname8
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE  :: i2a
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE  :: i2o
+   CHARACTER (len=50) :: cldiag_a2o, clw_a2o, clw_a2o_cdf, clw_a2o_mct
+   INTEGER (kind=il) :: ierr
+   LOGICAL :: l_no_pac
+   !!
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   INTEGER (kind=i_4) :: il_ncid
+!   CHARACTER (len=40) :: cl_atl, cl_pac, cl_noclo, cl_nomed, c_basins
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: tmask_atl, tmask_pac, tmask_noclose, tmask_nomed
+   !!
+   CHARACTER (len = 25) :: mo_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   !!
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   CALL inipar
+   CALL alloc_modeles
+   !!
+   CALL ipsldbg (l_ipsldbg)
+   !!
+   !! Initialisation
+   !!
+
+   ALLOCATE (imask (jpon, jp_calv), STAT=ierr)  ; CALL chk_allo (ierr, 'imask', lreset=.TRUE., crout='icestream')
+   ALLOCATE (zasrf_lat      (jpaj), STAT=ierr)  ; CALL chk_allo (ierr, 'zasrf_lat')
+   ALLOCATE (wtemp         (jpa2o), STAT=ierr)  ; CALL chk_allo (ierr, 'wtemp')
+   ALLOCATE (ktemp         (jpa2o), STAT=ierr)  ; CALL chk_allo (ierr, 'ktemp')
+   ALLOCATE (z2o      (jpoi, jpoj), STAT=ierr)  ; CALL chk_allo (ierr, 'z2o')
+   ALLOCATE (i2a      (jpai, jpaj), STAT=ierr)  ; CALL chk_allo (ierr, 'i2a')
+   ALLOCATE (i2o      (jpoi, jpoj), STAT=ierr)  ; CALL chk_allo (ierr, 'i2o')
+   ALLOCATE (tmask_atl      (jpon), STAT=ierr)  ; CALL chk_allo (ierr, 'tmask_atl')
+   ALLOCATE (tmask_pac      (jpon), STAT=ierr)  ; CALL chk_allo (ierr, 'tmask_pac')
+   ALLOCATE (tmask_noclose  (jpon), STAT=ierr)  ; CALL chk_allo (ierr, 'tmask_noclose')
+   ALLOCATE (tmask_nomed    (jpon), STAT=ierr)  ; CALL chk_allo (ierr, 'tmasl_nomed')
+   !!
+   ALLOCATE (ynorth (1:jp_calv), STAT=ierr) ; CALL chk_allo (ierr, 'ynorth')
+   ALLOCATE (ysouth (1:jp_calv), STAT=ierr) ; CALL chk_allo (ierr, 'ynorth')
+   !!
+   ysouth (1:jp_calv) = ylimits (1:jp_calv)
+   ynorth (1:jp_calv) = ylimits (2:jp_calv+1)
+   !!
+   !! Initialisation
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13 ; nchk = 14 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 21 ; nwei8o2a = 22 ; nwei4a2o = 23 ; nwei8a2o = 24
+   !
+   nout = 0
+   IF (nout /= 6 .AND. nout /= 0 ) THEN
+      OPEN (unit = nout, file = 'icestream.out', action = 'write', status = 'unknown', position = 'rewind' )
+   END IF
+   !
+   jma2o = 0_il ; jmo2a = 0_il ; nvo = 0_il
+   !!
+   !! Diagnostics files
+   !!
+!$$$  OPEN (unit = nout, file = 'icestreams.out', position = 'REWIND', action = 'write', status = 'replace' )
+!$$$  !!
+   !! Read coordinates of all models, and weights
+   !!
+   CALL lecdata (lecweights = .FALSE., leco2amask = .TRUE. )
+   !!
+   wa2o = zero ; ka2o = 0_il
+   !
+   CALL ipsldbg (l_ipsldbg)
+   !
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+   CALL lbc (xalont, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalonu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalonv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !!
+   CALL rectifie
+   !!
+   !! Calcul de la surface par bande de latitude atmosphere
+   DO jaj = 1_il, jpaj
+      zasrf_lat(jaj) = 0.0_rl
+      DO jai = 1_il, jpai
+         ja = m1a(1_il, jaj)
+         zasrf_lat(jaj) = zasrf_lat(jaj) + xasrft(ja)
+      END DO
+   ENDDO
+   DO jaj = 1, jpaj
+      WRITE(UNIT=nout,FMT='(1F7.1,1PE15.3)' ) xalatt ( m1a (1_il, jaj)), zasrf_lat (jaj)
+   END DO
+   WRITE(nout,*) SUM (zasrf_lat)
+   !!
+   CALL bord_a
+   !!
+   mo_name  = "mozaic" ; a2o_name = "a2o"
+   !!
+   CALL bord_o
+   CALL bord_oa
+   !!
+   WRITE (nout,*) 'o2amask ', COUNT (o2amask > 0 ), COUNT (o2amask <=  0 )
+   i2a = 0_il
+   WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) i2a = 1_il
+   !CALL prihin (i2a , 1_il, nout )
+   !!
+   !! Lecture masques de bassin
+   !IF ( TRIM (cotyp) == 'orca2' .OR. TRIM (cotyp) == 'orca2.0' .OR. TRIM (cotyp) == 'orca2.1' .OR. TRIM (cotyp) == 'orca4' ) THEN
+   !!IF ( l_calving_noatl .OR. l_calving_nopac ) THEN
+!-$$   c_basins = 'eORCA1.2.nc'
+!-$$   cl_atl   = 'mask_atl'
+!-$$   cl_pac   = 'mask_pac'
+!-$$   cl_nomed = 'mask_nomed'
+!-$$   cl_noclo = 'mask_noclose'
+
+   CALL flioopfd (TRIM (c_basins), il_ncid )
+   CALL fliogetv (il_ncid, TRIM (cl_atl)  , z2o ) ;  tmask_atl     = RESHAPE (z2o, (/ jpon /) )
+   CALL fliogetv (il_ncid, TRIM (cl_pac)  , z2o ) ;  tmask_pac     = RESHAPE (z2o, (/ jpon /) )
+   CALL fliogetv (il_ncid, TRIM (cl_noclo), z2o ) ;  tmask_noclose = RESHAPE (z2o, (/ jpon /) )
+   CALL fliogetv (il_ncid, TRIM (cl_nomed), z2o ) ;  tmask_nomed   = RESHAPE (z2o, (/ jpon /) )
+   CALL flioclo (il_ncid)
+
+
+!ELSE
+!      tmask_atl     = REAL (1-iomskt, rl)
+!      tmask_noclose = REAL (1-iomskt, rl)
+!      tmask_nomed   = REAL (1-iomskt, rl)
+   !   END IF
+   WRITE (unit=nout, fmt=*) 'iomskt'
+   CALL prihin (RESHAPE(iomskt             ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_atl'
+   CALL prihin (RESHAPE(NINT(tmask_atl)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_pac'
+   CALL prihin (RESHAPE(NINT(tmask_pac)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_nomed'
+   CALL prihin (RESHAPE(NINT(tmask_nomed)  ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_noclose'
+   CALL prihin (RESHAPE(NINT(tmask_noclose),(/jpoi,jpoj/)), 1_il, nout)
+
+   !
+   Bassin: DO jr = 1_il, jp_calv !! Boucle sur les zones
+      !!
+      !! Creation du masque
+      !!
+      imask (:,jr) = 1_il
+      !!
+      ! Limite nord incluse, limite sud exclue. Mers fermees exclues
+      IF (l_calving_nomed ) THEN
+         WHERE (tmask_nomed  (:) > 0.5_r_4 .AND. (xolatt > ysouth (jr) .AND. xolatt <= ynorth (jr)) ) imask(:,jr) = iomskt
+      ELSE
+         WHERE (tmask_noclose(:) > 0.5_r_4 .AND. (xolatt > ysouth (jr) .AND. xolatt <= ynorth (jr)) ) imask(:,jr) = iomskt
+      END IF
+      !!
+      IF ( jr > 1 ) THEN 
+         IF (l_calving_noatl) THEN
+            WHERE (tmask_atl (:) >  0.5_rl)  imask (:,jr) = 1_il
+            ! Mise a zero sur l'Arctique
+            WHERE (xolatt (:)    > 65.0_rl)  imask (:,jr) = 1_il
+         END IF
+         IF (l_calving_nopac) THEN
+            WHERE (tmask_pac (:) >  0.5_rl)  imask (:,jr) = 1_il
+         ENDIF
+      END IF
+      !!
+      WRITE(nout,*) 'Bassin ', jr
+      CALL prihin (RESHAPE ( imask(:,jr), (/jpoi, jpoj/)), 1_il, nout)
+      !!
+      !! Calcul de la surface totale de la zone ocean
+      zosrf = DOT_PRODUCT (xosrft, REAL(1-imask(:,jr),KIND=rl)*REAL(1-iomskp,KIND=rl) )
+      WRITE(nout,*) 'Surface de la zone ', jr, zosrf
+      !!
+      !! Calcul de la surface totale de la zone atmosphere
+      zasrf = 0.0_rl
+      DO ja = 1, jpan
+         IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) zasrf = zasrf + xasrft(ja)
+      END DO
+      !!
+      !! Calcul des poids
+      WRITE (nout,*) 'Calcul des poids'
+      DO jo = 1, jpon ! Boucle sur tous les points ocean
+         IF (imask(jo,jr) == 0_il ) THEN ! Vrai si le point NEMO est un point ocean dans la bande de latitude
+            DO jaj = 1_il, jpaj ! Boucle sur les latitudes atmosphere
+               ja = m1a(1_il, jaj) ! Indice 1D du point le plus Ã  l'ouest
+               IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) THEN ! Test si le point atmosphere est dans la bande de latitude
+                  nvo (jo) = nvo (jo) + 1 ! Increment du nombre de voisins
+                  IF (nvo(jo) .GT. jpa2o ) THEN ! Test sur le nombre maximum de voisin
+                     WRITE (nout,*) 'Nombre de voisins insuffisant ', jpa2o
+                     WRITE (nout,*) jr, jo, ja, xalatt(ja), ysouth(jr), ynorth(jr)
+                     STOP
+                  END IF
+                  ka2o (nvo(jo), jo) = ja
+                  wa2o (nvo(jo), jo) = zasrf_lat(jaj) / zosrf ! Division par la surface totale de la zone ocÃ©anique
+               ENDIF
+            ENDDO
+         END IF
+      END DO
+      !!
+      jma2o = MAXVAL (nvo)
+      !!
+      WRITE (nout,*) 'Fin bassin ' , jr
+   END DO Bassin
+   !!
+   WRITE(nout, *) 'jma2o : ', jma2o
+   !!
+   ! Tests bassins
+   WRITE(nout,*) 'Somme des bassins '
+   i2o =  RESHAPE (SUM(1-imask,DIM=2)*(1-iomskp), (/jpoi, jpoj/) )
+   CALL prihin (i2o, 1_il, nout)
+   !
+   WRITE(nout,*) 'Somme des bassins '
+   i2o =  RESHAPE ((1-iomskt)-SUM(1-imask,DIM=2)*(1-iomskp), (/jpoi, jpoj/) )
+   CALL prihin (i2o, 1_il, nout)
+   !
+   WRITE(nout,*) 'Somme des bassins '
+   i2o =  RESHAPE (SUM(imask,DIM=2), (/jpoi, jpoj/))
+   CALL prihin (i2o, 1_il, nout)
+   !!
+   !! Normalisation
+   !!
+!$$$      WRITE (nout, *) 'wa2o ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+!$$$      WRITE (nout, *) 'ka2o ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+!$$$      WRITE (nout, *) 'xasrft ', MINVAL (xasrft), MAXVAL (xasrft)
+!$$$      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+!$$$      WRITE (nout, *) 'xosrft ', MINVAL (xosrft), MAXVAL (xosrft)
+!$$$      WRITE (nout, *) 'iomskt ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+!$$$      WRITE (nout, *) 'iomskp ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+!$$$      WRITE (nout, *) 'iamskt ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+!$$$      WRITE (nout, *) 'locot ', COUNT (locot)
+   !!
+   CALL gather_wei
+   !!
+   !! Checking weights
+   WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9  )' ) MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+   WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9  )' ) MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+   jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+      & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+   jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+      & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+   !
+   jind(1:1) = INT(MAXLOC (nvo),il) ; jo = jind(1)
+   WRITE (unit = nout, fmt = *) jo, m2oi(jo), m2oj(jo), ka2o(1:nvo(jo),jo), &
+      & (m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo)), jn = 1, nvo(jo))
+   !!
+   ! Calcul du masque
+   CALL inter_a2o (REAL (1-iamskt, KIND = rl), a2omask)
+   !!
+!-$$   za = 1.0_rl
+!-$$   CALL inter_a2o (za, zo)
+!-$$   !
+!-$$   zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+   
+   !!
+   !! Verif nombre de voisins
+   !!
+   IF ( jma2oi /= jma2o ) THEN 
+      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+      WRITE (nout, *) ' jma2o calcule : ', jma2o
+      WRITE (nout, *) ' jma2o lu      : ', jma2oi
+      STOP
+   ENDIF
+   !!
+   !! Ecriture des poids
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+
+   IF (l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o.calvin" // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      IF ( l_calving_noatl ) cfname4 = TRIM (cfname4) // '_noatl'
+      IF ( l_calving_nopac ) cfname4 = TRIM (cfname4) // '_nopac'
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace', action = 'write')
+      WRITE (nout, *) 'Poids i_4 a -> o : ', TRIM(cfname4)
+   END IF
+
+   IF (l_wei_i8) THEN
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM(mo_name) // ".wa2o.calvin" // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+      IF ( l_calving_noatl ) cfname8 = TRIM (cfname8) // '_noatl'
+      IF ( l_calving_nopac ) cfname8 = TRIM (cfname8) // '_nopac'
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace', action = 'write')
+      WRITE (nout, *) 'Poids i_8 a -> o : ', TRIM(cfname8)
+   END IF
+   
+   cldiag_a2o  = TRIM(a2o_name) // '.calvin.diag'
+   clw_a2o     = 'mozaic.wa2o.calvin'
+   clw_a2o_mct = "rmp_"//TRIM(camod_t)//"_to_"//TRIM(comod_t)//"_MOSAIC_calvin"
+
+   IF ( l_calving_noatl ) THEN
+      cldiag_a2o  = TRIM (cldiag_a2o  ) // '_noatl'
+      clw_a2o     = TRIM (   clw_a2o  ) // '_noatl'
+      clw_a2o_mct = TRIM (clw_a2o_mct ) // '_noatl'
+   ENDIF
+   IF ( l_calving_nopac ) THEN
+      cldiag_a2o  = TRIM (cldiag_a2o  ) // '_nopac'
+      clw_a2o     = TRIM (   clw_a2o  ) // '_nopac'
+      clw_a2o_mct = TRIM (clw_a2o_mct ) // '_nopac'
+   ENDIF
+   cldiag_a2o  = TRIM ( cldiag_a2o)
+   clw_a2o     = TRIM ( clw_a2o   )
+   clw_a2o_mct = TRIM (clw_a2o_mct)
+
+   
+   WRITE (nout, *) 'Calling wri_weights_a2o ', cldiag_a2o, clw_a2o, "5"
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "5" )         
+
+   IF (l_wei_i4) CLOSE (unit = nwei8a2o)
+   IF (l_wei_i8) CLOSE (unit = nwei4a2o)
+   !
+   STOP
+   !!
+CONTAINS
+   !!
+   SUBROUTINE gather_wei
+      !!
+      WRITE (nout,*) 'Debut gather wei : perio'
+      jma2o = MAXVAL (nvo)
+      !! Periodicity
+      DO jn = 1, jma2o
+         CALL lbc (wa2o(jn,:) , noperio, 'T', jpoi, jpoj)
+         CALL lbc (ka2o(jn,:) , noperio, 'T', jpoi, jpoj)
+      END DO
+      !!
+      !! Gather weights
+      WRITE (nout,*) 'gather wei : gather'
+      DO jo = 1, jpon
+         ktemp = ka2o(:,jo) ; wtemp = wa2o(:,jo)
+         ka2o(:,jo) = 0_il  ; wa2o(:,jo) = 0.0_rl
+         kn = 1_il
+         DO jn = 1, jma2o
+            IF (ktemp(jn) /= 0_il ) THEN
+               ka2o(kn,jo) =  ktemp(jn)
+               wa2o(kn,jo) =  wtemp(jn)
+               kn = kn + 1_il
+            END IF
+         END DO
+      END DO
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !!
+   END SUBROUTINE gather_wei
+   !!
+END PROGRAM icestream
+
Index: /TOOLS/MOZAIC/src/MOZAIC/inipar.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/inipar.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/inipar.f90	(revision 3326)
@@ -0,0 +1,640 @@
+! -Mode: f90 -*-
+!!
+MODULE mod_inipar
+   !> prefixture du fichier de definitions
+CONTAINS
+   SUBROUTINE inipar
+      !!
+      USE defprec
+      USE dimensions
+      USE fliocom
+      USE getincom
+      USE errioipsl
+      !!
+      IMPLICIT NONE
+      INTEGER (kind=il)  :: ierr
+      CHARACTER (lEN=80) :: cn_arg
+      CHARACTER (LEN=LEN(c_suffix)) :: cl_suffix
+      !
+      WRITE (nout, *) 'Types par defaut : '
+      WRITE (nout, *) 'INTEGER : ', i_std
+      WRITE (nout, *) 'REAL    : ', r_std
+      !
+      !!
+      !Config Key  = c_suffix
+      !Config Desc = Rajoute un suffixe a tous les noms de fichiers
+      !Config Help = 
+      !Config Def  = 'none'
+      c_suffix = 'none'
+      CALL getin ('c_suffix', cl_suffix)
+      IF ( LEN_TRIM (cl_suffix) == 0 .OR. TRIM(cl_suffix) == 'none' ) THEN
+         c_suffix = ''
+      ELSE
+         c_suffix = '_' // TRIM(cl_suffix)
+      END IF
+      WRITE (unit=nout, fmt=*) 'cl_suffix : ', TRIM(cl_suffix)
+      WRITE (unit=nout, fmt=*) 'c_suffix : ', TRIM(c_suffix)
+
+      !Config Key  = c_comment
+      !Config Desc = Rajoute un commentaire dans tous les fichiers NetCDF
+      !Config Help = 
+      !Config Def  = 'none'
+      c_comment = 'none'
+      CALL getin ('c_comment', c_comment)
+      WRITE (unit=nout, fmt=*) 'c_comment : ', TRIM(c_comment)
+
+      !!
+      !Config Key  = l_ipsldbg 
+      !Config Desc = Pour mettre IOIPSL en mode debug.
+      !Config Help = 
+      !Config Def  = n
+      l_ipsldbg= .FALSE.
+      CALL getin ('l_ipsldbg', l_ipsldbg)
+      WRITE (unit=nout, fmt=*) 'l_ipsldbg = ', l_ipsldbg
+      CALL ipsldbg (l_ipsldbg)
+      !!
+      !Config Key  = l_d_alloc
+      !Config Desc = pour suivre les allocs memoire
+      !Config Help = 
+      !Config Def  = n
+      l_d_alloc = .FALSE.
+      CALL getin ('l_d_alloc', l_d_alloc)
+      WRITE (unit=nout, fmt=*) 'l_d_alloc = ', l_d_alloc
+      !
+      !Config Key  = l_fast 
+      !Config Desc = Pour tester les I/O : calcul rapide de poids
+      !Config Help = 
+      !Config Def  = n
+      l_fast = .FALSE.
+      CALL getin ('l_fast', l_fast)
+      WRITE (unit=nout, fmt=*) 'l_fast = ', l_fast
+      !Config Key  = l_dryrun 
+      !Config Desc = Pour tester les I/O : pas de calcul de poids.
+      !Config Help = 
+      !Config Def  = n
+      l_dryrun= .FALSE.
+      CALL getin ('l_dryrun', l_dryrun)
+      WRITE (unit=nout, fmt=*) 'l_dryrun = ', l_dryrun
+      !Config Key  = lev_dry
+      !Config Desc = Type de test
+      !Config Help = 
+      !Config Def  = 1
+      lev_dry= 1
+      CALL getin ('lev_dry', lev_dry)
+      WRITE (unit=nout, fmt=*) 'lev_dry = ', lev_dry
+      !!
+      !! Define ocean model
+      !!
+      !Config Key  = c_period 
+      !Config Help = 
+      !Config Def  = 'none'
+      c_period = 'none'
+      CALL getin ('c_period', c_period)
+      WRITE (unit=nout, fmt=*) 'c_period = ', c_period
+      !!
+      !Config Key  = jpoi 
+      !Config Desc = ocean x dimension
+      !Config Help = 
+      !Config Def  = 0
+      CALL getin ('jpoi', jpoi)
+      !Config Key  = jpoj
+      !Config Desc = ocean y dimension
+      !Config Help = 
+      !Config Def  = 0
+      CALL getin ('jpoj', jpoj)
+      WRITE (unit=nout, fmt=*) 'jpoi = ', jpoi, ' jpoj = ', jpoj
+      !Config Key  = comod
+      !Config Desc = ocean model name
+      !Config Help = 
+      !Config Def  = opa
+      CALL getin ('comod', comod)
+      !Config Key  = cotyp
+      !Config Desc = ocean model type
+      !Config Help = 
+      !Config Def  = orca2
+      cotyp = 'orca2'
+      CALL getin ('cotyp', cotyp)
+      WRITE (unit=nout, fmt=*) 'cotyp = ', cotyp
+      !Config Key  = jpoe
+      !Config Desc = number of edges for ocean
+      !Config Def  = 9
+      !Config Help = Number (maxi) of edges to describe ocean box
+      jpoe = 9_il
+      CALL getin ('jpoe', jpoe)
+      WRITE (unit=nout, fmt=*) 'jpoe = ', jpoe
+      !Config Key  = noperio
+      !Config Desc = ocean periodicity type
+      !Config Def  = 4
+      !Config Help = Number (maxi) of edges to describe ocean box
+      noperio = 4_il
+      CALL getin ('noperio', noperio)
+      WRITE (unit=nout, fmt=*) 'noperio = ', noperio 
+      !Config Key  = l_recalc_o
+      !Config Desc = Recompute ocean surfaces
+      !Config Def  = y
+      !Config Help = Recompute ocean surfaces
+      l_recalc_o = .TRUE.
+      CALL getin ('l_recalc_o', l_recalc_o)
+      WRITE (unit=nout, fmt=*) 'l_recalc_o = ', l_recalc_o 
+      !!
+      !! Define atmosphere model
+      !Config Key  = jpai 
+      !Config Desc = atm x dimension
+      !Config Help = 
+      !Config Def  = 0
+      CALL getin ('jpai', jpai)
+      !Config Key  = jpaj
+      !Config Desc = atm y dimension
+      !Config Help = 
+      !Config Def  = 0
+      CALL getin ('jpaj', jpaj)
+      jpait = jpai   ; jpajt = jpaj+1
+      jpaiu = jpai+1 ; jpaju = jpaj+1
+      jpaiv = jpai+1 ; jpajv = jpaj
+
+      jpaj = jpaj+1
+      WRITE (unit=nout, fmt=*) 'jpai  = ', jpai , ' jpaj  = ', jpaj
+      WRITE (unit=nout, fmt=*) 'jpait = ', jpait, ' jpajt = ', jpajt
+      WRITE (unit=nout, fmt=*) 'jpaiu = ', jpaiu, ' jpaju = ', jpaju
+      WRITE (unit=nout, fmt=*) 'jpaiv = ', jpaiv, ' jpajv = ', jpajv
+
+
+      !Config Key  = camod
+      !Config Desc = atm model name
+      !Config Help = 
+      !Config Def  = lmd
+      CALL getin ('camod', camod)
+      WRITE (unit=nout, fmt=*) 'comod = ', comod
+      !Config Key  = catyp
+      !Config Desc = atm model type
+      !Config Help = 
+      !Config Def  = lmdz
+      catyp = 'lmdz'
+      CALL getin ('catyp', catyp)
+      WRITE (unit=nout, fmt=*) 'catyp = ', catyp
+      !Config Key  = jpae
+      !Config Desc = number of edges for atm
+      !Config Def  = 9
+      !Config Help = Number (maxi) of edges to describe atm box
+      jpae = 9_il
+      CALL getin ('jpae', jpae)
+      WRITE (unit=nout, fmt=*) 'jpae = ', jpae
+      !Config Key  = naperio
+      !Config Desc = atm periodicity type
+      !Config Def  = -1
+      !Config Help = Number (maxi) of edges to describe ocean box
+      naperio = -1_il
+      CALL getin ('naperio', naperio)
+      WRITE (UNIT=nout, FMT=*) 'naperio = ', naperio 
+      
+      !Config Key  = la_nortop
+      !Config Desc = atm latitudes orientation in masks.nc, areas.nc, grids.nc
+      !Config Def  = .TRUE.
+      !Config Help = .TRUE. increasing latitudes
+      la_nortop = .TRUE.
+      CALL getin ('la_nortop', la_nortop)
+      WRITE (unit=nout, fmt=*) 'la_nortop = ', la_nortop
+
+      !Config Key  = l_recalc_a
+      !Config Desc = Recompute atm surfaces
+      !Config Def  = y
+      !Config Help = Recompute atm surfaces
+      l_recalc_a = .TRUE.
+      CALL getin ('l_recalc_a', l_recalc_a)
+      WRITE (unit=nout, fmt=*) 'l_recalc_a = ', l_recalc_a
+      
+      !Config Key  = la_pole 
+      !Config Desc special handing of atm pole point
+      !Config Def  = y
+      la_pole = .FALSE.
+      CALL getin ( 'la_pole', la_pole)
+      WRITE (unit=nout, fmt=*) 'la_pole = ', la_pole
+
+      !Config Key = o2a_orien
+      !Config Desc  = orientation for o2a diag file
+      !Config Def  = nord_en_haut
+      o2a_orien = "nord_en_haut"
+      CALL getin ( 'o2a_orien', o2a_orien)
+      WRITE (unit=nout, fmt=*) 'o2a_orien = ', TRIM(o2a_orien)
+
+      !Config Key  = lmaska
+      !Config Desc = If TRUE, masked points of atmospheric grid (land) are considered for computing.
+      !Config Def  = y
+      lmaska = .TRUE.
+      CALL getin ( 'lmaska', lmaska)
+      WRITE (unit=nout, fmt=*) 'lmaska = ', lmaska
+      
+      !Config Key  = lmasko
+      !Config Desc = If TRUE, masked points of ocean grid (land) are considered for computing.
+      !Config Def  = n
+      lmasko = .FALSE.
+      CALL getin ( 'lmasko', lmasko)
+      WRITE (unit=nout, fmt=*) 'lmasko = ', lmasko
+      
+      !Config Key  = lwro2a
+      !Config Desc = TRUE if oce -> atm weights/adresses are computed
+      !Config Def  = y
+      lwro2a = .TRUE.
+      CALL getin ( 'lwro2a', lwro2a)
+      WRITE (unit=nout, fmt=*) 'lwro2a = ', lwro2a
+
+      !Config Key  = lwra2o
+      !Config Desc = TRUE if atm -> oce weights/adresses are computed
+      !Config Def  = y
+      lwra2o = .TRUE.
+      CALL getin ( 'lwra2o', lwra2o)
+      WRITE (unit=nout, fmt=*) 'lwra2o = ', lwra2o
+      
+      !Config Key  = normo2a
+      !Config Desc = Type of normalization oce -> atm: 0: none, 1: intensive, 2: extensive
+      !Config Def  = 1
+      normo2a = 1
+      CALL getin ( 'normo2a', normo2a)
+      WRITE (unit=nout, fmt=*) 'normo2a = ', normo2a
+
+      !Config Key  = norma2o
+      !Config Desc = Type of normalization atm->oce : 0: none, 1: intensive, 2: extensive
+      !Config Def  = 1
+      norma2o = 1
+      CALL getin ( 'norma2o', norma2o)
+      WRITE (unit=nout, fmt=*) 'norma2o = ', norma2o
+
+!!!
+      !Config Key = jpa2o
+      !Config Desc = max number of neighbors of a->o weights
+      !Config Help = 
+      !Config Def = 0
+      CALL getin ('jpa2o', jpa2o)
+      WRITE (UNIT=nout, FMT=*) 'jpa2o = ', jpa2O 
+      !Config Key = jpo2a
+      !Config Desc = max number of neighbors of o-> weights
+      !Config Help = 
+      !Config Def = 0
+      CALL getin ('jpo2a', jpo2a)
+      WRITE (UNIT=nout, FMT=*) 'jpo2a = ', jpo2a 
+      !!
+      !Config Key = jma2o
+      !Config Desc = number of neighbors of a->o weights (fluxes)
+      !Config Help = 
+      !Config Def = 0
+      jma2o = jpa2o
+      CALL getin ('jma2o', jma2o)
+      WRITE (UNIT=nout, FMT=*) 'jma2o = ', jma2o 
+      !Config Key = jma2or
+      !Config Desc = number of neighbors of a->o weights (runoff)
+      !Config Help = 
+      !Config Def = 0
+      jma2or = jpa2o
+      CALL getin ('jma2or', jma2or)
+      WRITE (UNIT=nout, FMT=*) 'jma2or = ', jma2or 
+      !Config Key = jma2oi
+      !Config Desc = number of neighbors of a->o weights (icestreams)
+      !Config Help = 
+      !Config Def = 0
+      jma2oi = jpa2o
+      CALL getin ('jma2oi', jma2oi)
+      !Config Key = jmo2a
+      !Config Desc = number of neighbors of o->a weights (temp)
+      !Config Help = 
+      !Config Def = 0
+      jmo2a = jpo2a
+      CALL getin ('jmo2a', jmo2a)
+      WRITE (UNIT=nout, FMT=*) 'jmo2a = ', jmo2a 
+      !Config Key = norma2o
+      !Config Desc = type of normalization a->o
+      !Config Help = 
+      !Config Def = 0
+      norma2o = 1
+      CALL getin ('norma2o', norma2o)
+      WRITE (UNIT=nout, FMT=*) 'norma2o = ', norma2o
+      !Config Key = normo2a
+      !Config Desc = type of normalization o->a
+      !Config Help = 
+      !Config Def = 0
+      normo2a = 1
+      CALL getin ('normo2a', normo2a)
+      WRITE (UNIT=nout, FMT=*) 'normo2a = ', normo2a
+      !!
+      !Config Key = limit_stack
+      !Config Desc = use to limit memory usage in NetCDF
+      !Config Help = 
+      !Config Def = n
+      limit_stack = .FALSE.
+      CALL getin ('limit_stack', limit_stack)
+      WRITE (UNIT=nout, FMT=*) 'limit_stack = ', limit_stack 
+      !!
+      !Config Key = l_limit_iosize
+      !COnfig Desc = do not output some diagnostique to limit size of NetCDF files
+      !Config Help = 
+      !Config Def = n
+      l_limit_iosize = .FALSE.
+      CALL getin ('l_limit_iosize', l_limit_iosize)
+      WRITE (unit=nout, fmt=*) 'l_limit_iosize = ', l_limit_iosize
+      !Config Key = slice_size
+      !Config Desc = Size of slice in case of limit_stack
+      !Config Help = 
+      !Config Def = 10
+      slice_size = 10
+      CALL getin ('slice_size', slice_size)
+      WRITE (UNIT=nout, FMT=*) 'slice_size = ', slice_size
+      !Config Key = c_oasis
+      !Config Desc = define file format for Oasis
+      !Config Help = 
+      !Config Def = 2.2
+      c_oasis = '2.2'
+      CALL getin ('c_oasis', c_oasis)
+      WRITE (UNIT=nout, FMT=*) 'c_oasis = ', c_oasis 
+      !Config Key = l_grid_cdf
+      !Config Desc = Use if cdf grid should be produced
+      !Config Help = 
+      !Config Def = y
+      l_grid_cdf = .TRUE.
+      CALL getin ('l_grid_cdf', l_grid_cdf)
+      WRITE (UNIT=nout, FMT=*) 'l_grid_cdf = ', l_grid_cdf 
+!-$$      !Config Key = l_wei_cdf
+!-$$      !Config Desc = Use if cdf weights file produced
+!-$$      !Config Help = 
+!-$$      !Config Def = y
+!-$$      l_wei_cdf = .TRUE.
+!-$$      CALL getin ('l_wei_cdf', l_wei_cdf)
+!-$$      WRITE (UNIT=nout, FMT=*) 'l_wei_cdf = ', l_wei_cdf
+      !Config Key = l_wei_i4
+      !Config Desc = Use if i4 weights file produced
+      !Config Help = 
+      !Config Def = y
+      l_wei_i4 = .TRUE.
+      CALL getin ('l_wei_i4', l_wei_i4)
+      WRITE (UNIT=nout, FMT=*) 'l_wei_i4 = ', l_wei_i4
+      !Config Key = l_wei_i8
+      !Config Desc = Use if I8 weights file produced
+      !Config Help = 
+      !Config Def = y
+      l_wei_i8 = .FALSE.
+      CALL getin ('l_wei_i8', l_wei_i8)
+      WRITE (UNIT=nout, FMT=*) 'l_wei_i8 = ', l_wei_i8
+
+      !Config Key = l_wei_oasis_3
+      !Config Desc = Use if OASIS3 weights file produced
+      !Config Help = 
+      !Config Def = y
+      l_wei_oasis_3 = .TRUE.
+      CALL getin ('l_wei_oasis_3', l_wei_oasis_3)
+      WRITE (UNIT=nout, FMT=*) 'l_wei_oasis_3 = ', l_wei_oasis_3
+
+      !Config Key = l_wei_oasis_mct
+      !Config Desc = Use if OASIS MCT weights file produced
+      !Config Help = 
+      !Config Def = y
+      l_wei_oasis_mct = .TRUE.
+      CALL getin ('l_wei_oasis_mct', l_wei_oasis_mct)
+      WRITE (UNIT=nout, FMT=*) 'l_wei_oasis_mct = ', l_wei_oasis_mct
+      
+      !Config Key = c_read_wei
+      !Config Desc = determined in whihc format weights are read
+      !Config Help = 
+      !Config Def = oasis_3
+      CALL getin ('c_read_wei', c_read_wei)
+      WRITE (UNIT=nout, FMT=*) 'c_read_wei = ', TRIM(c_read_wei)
+      
+      !Config Key = c_FlioMode
+      !Config Desc = c_FlioMode = '32', '64', 'REPLACE', 'REP', 'REP64', 'HDF', 'REPHDF'
+      !Config Help = 
+      !Config Def = n
+      c_FlioMode = 'REPLACE'
+      CALL getin ('c_FlioMode', c_FlioMode)
+      WRITE (UNIT=nout, FMT=*) 'c_FlioMode = ', c_FlioMode
+      !!
+      !! =======================================
+      !!
+      !! Computed quantities
+      !!
+      jpon  = jpoi * jpoj     ! Global (1D) dimensions for ocean
+      jpan  = jpai * jpaj     ! Global (1D) dimensions for ocean
+      jpanu = jpai * jpaj
+      jpanv = jpai * jpaj
+      !!
+      WRITE (UNIT=nout, FMT=*) 'jpon  = ', jpon 
+      WRITE (UNIT=nout, FMT=*) 'jpan  = ', jpan 
+      WRITE (UNIT=nout, FMT=*) 'jpanu = ', jpanu 
+      WRITE (UNIT=nout, FMT=*) 'jpanv = ', jpanv 
+      !!
+      !Config Key = locerev
+      !Config Desc = Strategie de nommage. Si TRUE: opat.lon, sinon topa.lon
+      !Config Def = n
+      SELECT CASE (TRIM(cotyp))
+      CASE ('orca4')
+         WRITE (unit=nout,fmt=*) 'Case ORCA4 for locerev'
+         locerev = .TRUE. ! Si .TRUE. nom de champs type  opat.lon, sinon topa.lon
+      CASE ('orca2')
+         WRITE (unit=nout,fmt=*) 'Case ORCA2 for locerev'
+         locerev = .TRUE.
+      CASE ('orca2.1')
+         WRITE (unit=nout,fmt=*) 'Case ORCA2 for locerev'
+         locerev = .TRUE.
+      CASE Default
+         WRITE (unit=nout,fmt=*) 'Default case for locerev '
+         locerev = .FALSE.
+      END SELECT
+      CALL getin ('locerev', locerev)
+      WRITE (UNIT=nout, FMT=*) 'locerev = ', locerev
+      !!
+      !Config Key = lriv
+      !Config Desc = Traitement du runoff des rivières avec les embouchures exactes
+      !Config Def = n
+      lriv     = .FALSE. 
+      CALL getin ('lriv', lriv)
+      WRITE (UNIT=nout, FMT=*) 'lriv = ', lriv
+      !Config Key = lcoast
+      !Config Desc = Traitement specifique des points cotiers
+      !Config Def = y
+      lcoast   = .TRUE.  
+      CALL getin ('lcoast', lcoast)
+      WRITE (UNIT=nout, FMT=*) 'lcoast = ', lcoast
+      !Config Key = lint_atm
+      !Config Desc = Calcul pour run-off intégré sur la maille atm
+      !Config Def = y
+      lint_atm = .TRUE.   
+      CALL getin ('lint_atm', lint_atm)
+      WRITE (UNIT=nout, FMT=*) 'lint_atm = ', lint_atm
+      !Config Key = lint_oce
+      !Config Desc = Calcul pour run-off intégré sur la maille oce
+      !Config Def = n
+      CALL getin ('lint_oce', lint_oce)
+      lint_oce = .FALSE.  
+      WRITE (UNIT=nout, FMT=*) 'lint_oce = ', lint_oce
+
+
+      !Config Key = l_etal_oce
+      !Config Desc =  ! On etale sur les point océans  proches
+      !Config Def = n
+      l_etal_oce = .TRUE.
+      CALL getin ('l_etal_oce', l_etal_oce)
+      WRITE (UNIT=nout, FMT=*) 'l_etal_oce = ',l_etal_oce
+
+      !Config Key = dist_etal_oce
+      !Config Desc =  ! On etale sur les point océans  proches
+      !Config Def = 400.0E0
+      l_etal_oce = .TRUE.
+      CALL getin ('dist_etal_oce', dist_etal_oce)
+      WRITE (UNIT=nout, FMT=*) 'dist_etal_oce = ', dist_etal_oce
+      
+      !Config Key = lnear
+      !Config Desc =  Extension de 1 point a l''interieur, vers le point ocean le plus proche'
+      !Config Def = n
+      lnear    = .FALSE.  
+      CALL getin ('lnear', lnear)
+      WRITE (UNIT=nout, FMT=*) 'lnear = ', lnear
+
+      !Config Key = lnei
+      !Config Desc = Extension de 1 point a l''interieur, vers le point atm voisin'
+      !Config Def = n
+      lnei     = .FALSE.  
+      CALL getin ('lnei', lnei)
+      WRITE (UNIT=nout, FMT=*)  'lnei = ', lnei
+
+      !Config Key = ltotal
+      !Config Desc = les point atmosphères mouilles les plus proches.
+      !Config Def = n
+      ltotal = .FALSE.    ! Route tout les point atm vers l'oce le plus proche.
+      CALL getin ('ltotal', ltotal)
+      WRITE (UNIT=nout, FMT=*) 'ltotal = ', ltotal
+      !Config Key = ltotal_dist
+
+      !Config Desc =  ! Route tout les point atm vers l'oce le plus proche, avec distance maxi
+      !Config Def = n
+      ltotal_dist = .FALSE.
+      CALL getin ('ltotal_dist', ltotal_dist)
+      WRITE (UNIT=nout, FMT=*) 'ltotal_dist = ', ltotal_dist
+
+      !Config Key = ltotal_dist_2
+      !Config Desc =  ! Route tout les point atm vers les oce le plus proche, avec distance maxi
+      !               ! On etale sur les point océans cotes proches
+      !Config Def = n
+      ltotal_dist_2 = .TRUE.
+      CALL getin ('ltotal_dist_2', ltotal_dist_2)
+      WRITE (UNIT=nout, FMT=*) 'ltotal_dist_2 = ', ltotal_dist_2
+
+      !Config Key = ltotal_dist_3
+      !Config Desc =  ! Route tout les point atm vers les oce le plus proche, avec distance maxi
+      !               ! On etale sur les point océans proches, cotiers ou pas
+      !Config Def = n
+      ltotal_dist_3 = .TRUE.
+      CALL getin ('ltotal_dist_3', ltotal_dist_3)
+      WRITE (UNIT=nout, FMT=*) 'ltotal_dist_3 = ', ltotal_dist_3
+
+     
+      !Config Key = dist_max
+      !Config Desc = Distance maximale de recherche des voisins océans cotiers
+      !Config Def = 400.0E3
+      dist_max = 400.0E3_rl
+      CALL getin ('dist_max_voisin', dist_max)
+      WRITE (UNIT=nout, FMT=*) 'dist_max = ', dist_max
+
+      !Config Key = dist_max_oce
+      !Config Desc = Distance maximale de recherche des voisins océans
+      !Config Def = 400.0E3
+      dist_max_oce = 400.0E3_rl
+      CALL getin ('dist_max_oce', dist_max_oce)
+      WRITE (UNIT=nout, FMT=*) 'dist_max_oce = ', dist_max_oce
+
+      !Config Key = dist_max_atm
+      !Config Desc = Distance maximale de recherche des voisins atmosphere
+      !Config Def = 400.0E3
+      dist_max_atm = 400.0E3_rl
+      CALL getin ('dist_max_atm', dist_max_atm)
+      WRITE (UNIT=nout, FMT=*) 'dist_max_atm = ', dist_max_atm
+      
+      
+      !Config Key = dist_max_large
+      !Config Desc = Distance maximale de recherche des larges océans, vers le large
+      !Config Def = 400.0E3
+      dist_max_large = 400.0E3_rl
+      CALL getin ('dist_max_large', dist_max_large)
+      WRITE (UNIT=nout, FMT=*) 'dist_max_large = ', dist_max_large
+
+      l_large = .TRUE.
+      CALL getin ( 'l_large', l_large)
+
+      !!
+      !Config Key = lessai
+      !Config Desc = Essai de completion du run-off
+      !Config Def = n
+      lessai = .FALSE.
+      CALL getin ('lessai', lessai)
+      WRITE (UNIT=nout, FMT=*) 'lessai = ', lessai
+
+
+      !Config Key = jp_calv
+      !Config Desc = nombre de bandes pour le calving
+      !Config Def = 3
+      jp_calv = 3
+      CALL getin ('jp_calv', jp_calv)
+      WRITE (nout,*) 'Nombre de bandes : ', jp_calv
+
+      ALLOCATE (ylimits (1:jp_calv+1), STAT=ierr) ; CALL chk_allo (ierr, 'ylimits')
+      !Config Key = ylimits
+      !Config Desc = nombre de bandes pour le calving
+      CALL getin ('ylimits', ylimits)
+      WRITE (nout,*) 'Limites des  bandes : ', ylimits
+
+      !Config Key = l_calving_nomed
+      !Config Desc = Calving does not go to mediterranean seas (includes Red Sea, Persian Gulf)
+      !Config Def = n
+      l_calving_nomed = .FALSE.
+      CALL getin ('l_calving_nomed', l_calving_nomed)
+      WRITE (UNIT=nout, FMT=*) 'l_calving_nomed = ', l_calving_nomed
+      
+      !Config Key = l_calving_noatl
+      !Config Desc = Calving does not go to Atlantic
+      !Config Def = n
+      l_calving_noatl = .FALSE.
+      CALL getin ('l_calving_noatl', l_calving_noatl)
+      WRITE (UNIT=nout, FMT=*) 'l_calving_noatl = ', l_calving_noatl
+
+      !Config Key = l_calving_nopac
+      !Config Desc = Calving does not go to Pacific
+      !Config Def = n
+      l_calving_nopac = .FALSE.
+      CALL getin ('l_calving_nopac', l_calving_nopac)
+      WRITE (UNIT=nout, FMT=*) 'l_calving_nopac = ', l_calving_nopac
+      
+      !Config Key = cotes_omsk
+      !Config Desc = what ocean mask is written in Mosaic MCT file for runoff
+      !Config Def = noperio
+      cotes_omsk='noperio'
+      CALL getin ('cotes_omsk', cotes_omsk)
+      WRITE (UNIT=nout, FMT=*) 'cotes_omsk = ', TRIM(cotes_omsk)
+
+      !Config Key = cotes_amsk
+      !Config Desc = what atm mask is written in Mosaic MCT file for runoff
+      !Config Def = full
+      cotes_amsk='full'
+      CALL getin ('cotes_amsk', cotes_amsk)
+      WRITE (UNIT=nout, FMT=*) 'cotes_amsk = ', TRIM(cotes_amsk)
+
+      c_basins = 'eORCA1.2.nc'
+      CALL getin ( 'c_basins', c_basins)
+      WRITE (UNIT=nout, FMT=*) 'c_basins = ', c_basins
+      
+      cl_atl   = 'mask_atl'
+      CALL getin ('cl_atl', cl_atl )
+      WRITE (UNIT=nout, FMT=*) 'cl_atl = ', cl_atl
+            
+      cl_pac   = 'mask_pac'
+      CALL getin ('cl_pac', cl_pac )
+      WRITE (UNIT=nout, FMT=*) 'cl_pac = ', cl_pac
+            
+      cl_nomed = 'mask_nomed'
+      CALL getin ('cl_nomed', cl_nomed )
+      WRITE (UNIT=nout, FMT=*) 'cl_nomed = ',cl_nomed
+
+      cl_noclo = 'mask_noclose'
+      CALL getin ('cl_noclo', cl_noclo )
+      WRITE (UNIT=nout, FMT=*) 'cl_noclo = ', cl_noclo
+
+
+      CALL getin_dump !! ( 'used' // TRIM(c_suffix))
+      !!
+   END SUBROUTINE inipar
+END MODULE mod_inipar
+
Index: /TOOLS/MOZAIC/src/MOZAIC/inter.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/inter.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/inter.f90	(revision 3326)
@@ -0,0 +1,50 @@
+! -*- Mode: f90 -*-
+MODULE mod_inter
+   USE modeles
+   USE mod_lbc
+CONTAINS
+   SUBROUTINE inter_o2a (pin, pout)
+      !> Interpolation ocean -> atmosphere
+      IMPLICIT NONE
+      !!
+      REAL (kind = rl), DIMENSION (jpon), INTENT ( in) :: pin
+      REAL (kind = rl), DIMENSION (jpan), INTENT (out) :: pout
+      INTEGER (kind = il) :: ja, jn, kn
+      !!
+      pout = 0.0_rl
+      DO ja = 1, jpan
+         DO jn = 1, jmo2a
+            kn = ko2a (jn, ja)
+            IF (kn > 0) pout (ja) = pout (ja) + wo2a (jn, ja) * pin (kn)
+         END DO
+      END DO
+      !!
+      CALL lbc (pout, naperio, 'T', jpai, jpaj)
+      !!
+      RETURN
+      !!
+   END SUBROUTINE inter_o2a
+   !!
+   SUBROUTINE inter_a2o (pin, pout)
+      !> Interpolation ocean -> atmosphere
+      IMPLICIT NONE
+      !!
+      REAL (kind = rl), DIMENSION (jpan), INTENT ( in) :: pin
+      REAL (kind = rl), DIMENSION (jpon), INTENT (out) :: pout
+      INTEGER (kind = il) :: jo, jn, kn
+      !!
+      pout = 0.0_rl
+      DO jo = 1, jpon
+         DO jn = 1, jma2o
+            kn = ka2o (jn, jo)
+            IF (kn > 0) pout (jo) = pout (jo) + wa2o (jn, jo) * pin (kn)
+         END DO
+      END DO
+      !!
+      CALL lbc (pout, noperio, 'T', jpoi, jpoj)
+      !!
+      RETURN
+      !!
+   END SUBROUTINE inter_a2o
+   !!
+END MODULE mod_inter
Index: /TOOLS/MOZAIC/src/MOZAIC/interpol.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/interpol.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/interpol.f90	(revision 3326)
@@ -0,0 +1,355 @@
+! -*- Mode: f90 -*-
+!!! 
+!!! lecture d'un fichier NetCDF et interpolation type Mosaic
+!!! Suppose un calcul préalable des poids
+!!!
+!!! Modifiez le module 'modele' selon votre cas de figure
+!!!
+MODULE declare_1
+   !!
+   USE defprec
+   IMPLICIT NONE
+   !! Data types
+   INTEGER, PARAMETER :: r4 = r_4, r8 = r_8
+   INTEGER, PARAMETER :: i1=1, i2 = 2, i4 = i_4, i8 = i_8
+   INTEGER, PARAMETER :: rl = r_std, il = i_std
+   INTEGER (kind=il), PARAMETER :: nout = 6 ! Fichier de sortie des messages
+   !!
+END MODULE declare_1
+!!
+MODULE modele_1
+  USE declare_1
+  IMPLICIT NONE
+  CHARACTER (len=80) :: cfile_in = 'routing.nc' ! Fichier entree
+  CHARACTER (len=80) :: cfile_ou = 'runoff_oce.nc' ! Fichier sortie
+  ! OPA -> LMD
+!$$$  INTEGER (kind=il), PARAMETER :: jpi1 = 92, jpj1 = 76, jpk1 = 1      ! Dimension modele entree
+!$$$  INTEGER (kind=il), PARAMETER :: jpi2 = 72, jpj2 = 46, jpk2 = 1      ! Dimension modele sortie
+!$$$  CHARACTER (len=8) :: clweight =  "WEIGHTS1" , cladress = "ADRESSE1" ! Reference des poids et adresses à utiliser
+!$$$  INTEGER (kind=il), PARAMETER :: jpn   = 15_il ! Nombre maxi de voisins
+  ! LMD -> OPA
+  INTEGER (kind=il), PARAMETER :: jpi1 = 72_il, jpj1 = 46_il, jpk1 = 1_il ! Dimension modele entree
+  INTEGER (kind=il), PARAMETER :: jpi2 = 92_il, jpj2 = 76_il, jpk2 = 1_il ! Dimension modele sortie
+  CHARACTER (len=8) :: clweight =  "WEIGHTS4" , cladress = "ADRESSE4" ! Reference des poids et adresses à utiliser
+  INTEGER (kind=il), PARAMETER :: jpn   = 6_il ! Nombre maxi de voisins
+  CHARACTER (len=80) :: cfile_ma = '/home/users/marti/GRAF/DATA/orca4.nc' ! Fichier geo sortie
+  !
+  INTEGER (kind=il), PARAMETER :: jpdim =  4_il ! Nombre maxi de dimensions
+  INTEGER (kind=il), PARAMETER :: jpvar = 30_il ! Nombre maxi de variables
+  CHARACTER (len=8) :: ctaux = 'FRTU', ctauy = 'FRTV' ! Nom des composantes du stress
+  REAL (kind=r8) :: zfreeze = -1.77_r8 ! Point de congélation
+  !
+  REAL    (kind=rl), DIMENSION ( jpn,jpi2*jpj2) :: weight
+  INTEGER (kind=il), DIMENSION ( jpn,jpi2*jpj2) :: kadd
+  REAL    (kind=rl), DIMENSION ( jpi2*jpj2) :: glon, glat
+END MODULE modele_1
+!!
+PROGRAM interpol
+   USE declare_1
+   USE modele_1
+   USE fliocom
+   USE errioipsl
+   IMPLICIT NONE
+   INTEGER (kind=i4),PARAMETER :: in = i4
+   !! 
+   REAL (kind=r8), DIMENSION (jpi1*jpj1) :: zvar_in8
+   REAL (kind=r8), DIMENSION (jpi2*jpj2) :: zvar_ou8
+   INTEGER (kind=i4), DIMENSION (flio_max_dims) :: dim_len1, dim_len2
+   CHARACTER (len=20), DIMENSION (flio_max_dims) :: cldim
+   INTEGER (kind=i4) :: jdim, jvar
+   INTEGER (kind=i4), DIMENSION (jpvar) :: xtype, ndims, natts
+   REAL (kind=r8), DIMENSION (jpvar) :: spval = 0.0_r8
+   CHARACTER (len=20), DIMENSION (jpvar) :: clvar
+   INTEGER (kind=i4), DIMENSION (jpvar, flio_max_dims) :: dimsid
+   INTEGER (kind=in) :: jd, jv, jn, jo 
+   INTEGER (kind=il) :: ji, jj, jt, jnt, tid, xid, yid, tid_v, kerr
+   INTEGER (kind=i4) :: ncid_in, ncid_ou, ncid_ma, ja
+   INTEGER (kind=il) :: len1, len2, nwei = 13
+   CHARACTER (len=8) :: c8
+   INTEGER (kind=i4), DIMENSION ( jpdim) :: istart1, istart2, icount1, icount2
+   CHARACTER (len=80) :: cname
+   REAL (kind=r8), DIMENSION ( :), ALLOCATABLE :: zt
+   INTEGER (kind=il)       , DIMENSION ( :), ALLOCATABLE :: it
+   CHARACTER (len=80) :: cfname
+   ! For flio
+   CHARACTER (len=80), DIMENSION(1) :: catt
+   LOGICAL :: l_ex
+   !!
+   !! Lecture poids et adresses
+   WRITE ( unit = cfname, fmt = '("/home/climdata/ocean/CPL/ORCA4xLMD7245/mozaic.w.runoff.i", 1I1, ".r", 1I1)' ) il, rl
+   OPEN ( unit = nwei, file = TRIM(cfname), form = 'unformatted', status = 'old', action = 'read')
+   ALLOCATE ( it ( jpi2*jpj2*jpn) )
+   CALL locrint (cladress, it, jpi2*jpj2*jpn, nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 055
+   DO jo = 1, jpi2*jpj2
+      DO jn = 1, jpn
+         kadd  (jn, jo) = it ( jn + (jo-1)*jpn)
+      END DO
+   ENDDO
+   DEALLOCATE ( it)
+   !
+   ALLOCATE ( zt ( jpi2*jpj2*jpn) )
+   CALL locread (clweight, zt, jpi2*jpj2*jpn, nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 056
+   DO jo = 1, jpi2*jpj2
+      DO jn = 1, jpn
+         weight (jn, jo) = zt (jn + (jo-1)*jpn)
+      END DO
+   ENDDO
+   DEALLOCATE ( zt)
+   !! Lecture geo
+   CALL flioopfd (TRIM(cfile_ma), ncid_ma)
+   CALL fliogetv (ncid_ma, 'nav_lon', glon)
+   CALL fliogetv (ncid_ma, 'nav_lat', glat)
+   CALL flioclo  (ncid_ma)
+   !! Ouverture fichier entree
+   CALL flioopfd (TRIM(cfile_in), ncid_in, nb_dim=jdim, nb_gat=natts(1))
+   !! Dimensions
+   CALL flioinqf (ncid_in, ln_dim=dim_len1(1:jdim), nb_var=jvar )
+   CALL flioinqn (ncid_in, cn_dim=cldim(1:jdim), cn_var=clvar(1:jvar))
+   SeekDim: DO jd = 1, jdim
+      WRITE ( unit = c8, fmt = '(1I8)' ) jd
+      IF      ( dim_len1 (jd) == jpi1 ) THEN 
+         dim_len2 (jd) = jpi2
+      ELSE IF ( dim_len1 (jd) == jpj1 ) THEN 
+         dim_len2 (jd) = jpj2
+      ELSE IF ( dim_len1 (jd) == jpk1 ) THEN 
+         dim_len2 (jd) = jpk2
+      ELSE 
+         dim_len2 (jd) = dim_len1 (jd)
+      END IF
+      ! Determination du nombre de pas de temps
+      jnt = 0
+      WRITE(unit=c8,fmt='(2I4)') jd
+      IF ( INDEX ( cldim(jd), 'time') /= 0 .OR. INDEX ( cldim(jd), 'TIME') /= 0 .OR. INDEX ( cldim(jd), 'Time') /= 0) THEN 
+         jnt = dim_len1(jd) ; tid = jd ; dim_len2 (jd) = -1 ! Unlimited dimension
+      END IF
+      IF ( INDEX ( cldim(jd), 'X') /= 0 .OR. INDEX ( cldim(jd), 'x') /= 0 ) xid = jd 
+      IF ( INDEX ( cldim(jd), 'Y') /= 0 .OR. INDEX ( cldim(jd), 'y') /= 0 ) yid = jd 
+   END DO SeekDim
+   WRITE ( nout, *) 'Nombre de dimensions : ', jdim
+   WRITE ( nout, *) 'Longueur temps       : ', jnt
+   WRITE ( nout, *) 'Dimension temps : ', tid, cldim(tid)
+   !! Ouverture fichier sortie
+   CALL fliocrfd (TRIM(cfile_ou), cldim(1:jdim), dim_len2(1:jdim), ncid_in )
+   CALL flioputa (ncid_in, '?', 'Comment', TRIM(c_comment) )
+   !! Attributs globaux
+   DO ja = 1, natts (1) 
+      WRITE ( unit = c8, fmt = '(2I4)' ) ja
+      CALL flioinqn (ncid_in, ia_start=ja, ia_count=1, cn_gat=catt) ; cname=catt(1)
+      CALL fliocpya (ncid_in, '?', cname, ncid_ou, '?' )
+   END DO
+   !! Definition variables
+   SeekVar: DO jv = 1, jvar
+      CALL flioinqv (ncid_in, TRIM(clvar(jv)), l_ex, nb_atts=natts(jv), v_t=xtype(jv), nb_dims=ndims(jv))
+      CALL flioinqv (ncid_in, TRIM(clvar(jv)), l_ex, id_dims=dimsid(jv,1:ndims(jv)))
+      WRITE ( nout, FMT='(1A20,8I5)' ) TRIM(clvar(jv)), xtype(jv), dimsid(jv,1:ndims(jv)), natts(jv), jv
+      IF ( INDEX ( clvar(jv), 'time') /= 0 .OR. INDEX ( clvar(jv), 'TIME') /= 0 .OR. &
+         & INDEX ( clvar(jv), 'Time') /= 0) tid_v = jv
+      CALL fliodefv (ncid_ou, TRIM(clvar(jv)), dimsid(jv,1:ndims(jv)), v_t=xtype(jv))
+      !! Traitements des attributs
+      DO ja = 1, natts(jv)
+         WRITE ( unit = c8, fmt = '(2I4)' ) jv, ja
+         CALL flioinqv (ncid_in, TRIM(clvar(jv)), l_ex, ia_start=ja, ia_count=1, cn_atts=catt) ; cname=catt(1)
+         CALL fliocpya (ncid_in, TRIM(clvar(jv)), cname, ncid_ou, TRIM(clvar(jv)) )
+      END DO
+      IF ( TRIM(cname) == 'missing_value' .OR. TRIM(cname) == 'MISSING_VALUE' ) THEN 
+         CALL fliogeta ( ncid_in, TRIM(clvar(jv)), cname, spval(jv))
+         WRITE ( unit = nout, fmt = *) 'Missing value ' // TRIM (clvar(jv)) // " : ", spval(jv)
+      ENDIF
+   END DO SeekVar
+   !!
+   Temps: DO jt = 1_il, 50 !jnt
+      Var: DO jv = 1_il, jvar
+         WRITE(unit=c8,fmt='(2I4)') jt, jv
+         istart1 = 1_il ; icount1 = 1_il
+         istart2 = 1_il ; icount2 = 1_il
+         SELECT CASE ( ndims(jv) )
+         CASE (1)
+            IF      ( jv == tid_v ) THEN 
+               istart1 (1_il)= jt ; icount1 (1_il) = 1_il
+               istart2 (1_il)= jt ; icount2 (1_il) = 1_il
+            ELSE IF ( jv == xid ) THEN
+               istart1 (1_il) = 1_il ; icount1 (1_il) = jpi1
+               istart2 (1_il) = 1_il ; icount2 (1_il) = jpi2
+               CALL flioputv (ncid_ou, TRIM(clvar(jv)),  (/ (REAL(ji,kind=r8),ji=1,jpi2) /) ) ! Ecrit Y
+               CYCLE var
+            ELSE IF ( jv == yid ) THEN 
+               istart1 (1_il) = 1_il ; icount1 (1) = jpj1
+               istart2 (1_il) = 1_il ; icount2 (1) = jpj2
+               CALL flioputv (ncid_ou, TRIM(clvar(jv)),  (/ (REAL(jj,kind=r8),jj=1,jpj2) /) ) ! Ecrit Y
+               CYCLE var
+            ELSE
+               IF ( jt > 1_il) CYCLE var
+            END IF
+         CASE ( 2) 
+            IF ( jt > 1 ) CYCLE var
+            istart1 (1:2) = (/  1_il, 1_il /) ; icount1 (1:2) = (/jpi1, jpj1 /)
+            istart2 (1:2) = (/  1_il, 1_il /) ; icount2 (1:2) = (/jpi2, jpj2 /)
+         CASE ( 3) 
+            istart1 (1:3) = (/  1_il, 1_il, jt /)
+            icount1 (1:3) = (/jpi1, jpj1, 1_il /)
+            istart2 (1:3) = (/  1_il, 1_il, jt /)
+            icount2 (1:3) = (/jpi2, jpj2, 1_il /)
+         CASE ( 4) 
+            istart1 (1:4) = (/  1_il, 1_il, 1_il, jt /) ; icount1 (1:4)  = (/jpi1, jpj1, 1_il, 1_il /)
+            istart2 (1:4) = (/  1_il, 1_il, 1_il, jt /) ; icount2 (1:4)  = (/jpi2, jpj2, 1_il, 1_il /)
+         END SELECT
+         !!
+         len1 = product ( icount1 ) ; len2 = product ( icount2 )
+         WRITE ( nout, FMT = '("No ", 1I3, ", Nom : ", 1A20, ", Time : ", 1I3, ", Lens : ", 2I6, ", Type : ", 1I4)' ) &
+            &  jv, TRIM(clvar(jv)), jt, len1, len2, xtype(jv)
+         !
+         ! Lecture
+         CALL fliogetv ( ncid_in, TRIM(clvar(jv)), zvar_in8(1:len1), istart1, icount1)
+         zvar_in8(1:len1) = zvar_in8(1:len1) + 0.0_r8
+         WHERE ( zvar_in8(1:len1) == spval ( jv) ) zvar_in8(1:len1) = 0.0_r8
+!$$$      WRITE (nout,*) 'extrema entree : ', MINVAL ( zvar_in8(1:len1)) , MAXVAL ( zvar_in8(1:len1))
+         ! Interpolation eventuelle
+         IF ( ndims(jv) == 1 ) THEN 
+            zvar_ou8(1:len1) = zvar_in8(1:len1)
+         ELSE
+!$$$          IF ( jv == 6 ) THEN 
+!$$$              WRITE(nout,*) 'Attention : traitement glace '
+!$$$              DO ji = 1, len1
+!$$$                IF ( zvar_in8(ji) <= zfreeze ) THEN
+!$$$                     zvar_in8(ji) = 1.0_rl
+!$$$                 ELSE
+!$$$                     zvar_in8(ji) = 0.0_rl
+!$$$                 END IF
+!$$$               END DO
+!$$$          ENDIF
+            IF      ( TRIM(clvar(jv)) == 'nav_lon' .OR. TRIM(clvar(jv)) == 'longitude' .OR. & 
+               &      TRIM(clvar(jv)) == 'NAV_LON' .OR. TRIM(clvar(jv)) == 'LONGITUDE' ) THEN
+               zvar_ou8(1:len2) = glon
+            ELSE IF ( TRIM(clvar(jv)) == 'nav_lat' .OR. TRIM(clvar(jv)) == 'latitude' .OR. &
+               &      TRIM(clvar(jv)) == 'NAV_LAT' .OR. TRIM(clvar(jv)) == 'LATITUDE' ) THEN
+               zvar_ou8(1:len2) = glat
+            ELSE
+               CALL inter ( zvar_in8(1:len1), zvar_ou8(1:len2))
+            ENDIF
+         END IF
+!$$$      WRITE (nout,*) 'extrema sortie : ', MINVAL ( zvar_ou8(1:len2)) , MAXVAL ( zvar_ou8(1:len2))
+         WRITE (nout,FMT='("extrema : ",4E12.3)' ) MINVAL ( zvar_in8(1:len1)), MINVAL ( zvar_ou8(1:len2)) &
+            &  , MAXVAL ( zvar_in8(1:len1)), MAXVAL ( zvar_ou8(1:len2))
+         ! Ecriture
+         CALL flioputv ( ncid_ou, TRIM(clvar(jv)), zvar_ou8(1:len2))
+      END DO Var
+   END DO Temps
+
+   !!
+   CALL flioclo ( ncid_in)
+   CALL flioclo ( ncid_ou)
+
+   STOP
+CONTAINS
+   SUBROUTINE inter ( pin, pout)
+      USE declare_1
+      USE modele_1
+      IMPLICIT NONE
+      REAL (kind=r8), INTENT ( in), DIMENSION ( jpi1*jpj1) :: pin
+      REAL (kind=r8), INTENT (out), DIMENSION ( jpi2*jpj2) :: pout
+      INTEGER (kind=il) :: ji, jn, in
+      !!
+      pout = 0.0_rl
+      !
+      DO ji = 1, jpi2*jpj2
+         DO jn = 1, jpn
+            in  = kadd ( jn, ji)
+            IF ( in > 0 ) pout ( ji) = pout ( ji) + weight ( jn, ji) * pin ( in )
+         END DO
+      END DO
+      !!
+   END SUBROUTINE inter
+   !!
+   SUBROUTINE locread ( cdfldn, pfield, kdimax, knulre, kflgre, kout)
+      USE declare_1
+      !!
+      IMPLICIT NONE
+      !
+      CHARACTER (LEN = 8), INTENT ( in) :: cdfldn ! Name of field to search for
+      INTEGER (kind=il), INTENT (  in) :: kdimax, knulre    ! Field dimension, unit to read
+      INTEGER (kind=il), INTENT (  in) :: kout              ! Standard output
+      INTEGER (kind=il), INTENT ( out) :: kflgre            ! Error status code
+      REAL (kind=r8)  , INTENT ( out), DIMENSION ( :) :: pfield ! Field
+      !
+      CHARACTER (len = 8) clecfl
+      INTEGER (kind=il) :: ji, kerr
+      !
+      !*    1. Initialization
+      !        --------------
+      !
+      WRITE (UNIT = kout,FMT = '( "Locread :  Read field ", A8, " in unit = ", 1I6)' ) cdfldn, knulre
+      !
+      !     2. Find field in file
+      !        ------------------
+      !
+      REWIND ( UNIT = knulre)
+200   CONTINUE
+      !* Find string
+      READ (UNIT = knulre, ERR = 200, END = 210, IOSTAT = kerr) clecfl
+      IF ( clecfl /= cdfldn ) GO TO  200
+      !* Read associated field
+      READ (UNIT = knulre, IOSTAT = kerr) ( pfield (ji),ji = 1, kdimax)
+      IF ( kerr /= 0 ) WRITE ( unit = nout, fmt = *) 'Problem reading field'
+      kflgre = 0
+      GO TO 220
+      !* Problem in reading
+210   kflgre = 1
+      WRITE ( unit = nout, fmt = *) 'Problem in reading'
+220   CONTINUE
+      !
+      !*    3. End of routine
+      !        --------------
+      !
+      RETURN
+   END SUBROUTINE locread
+   !
+   SUBROUTINE locrint ( cdfldn, kfield, kdimax, knulre, kflgre, kout)
+      !
+      USE declare_1
+      !!
+      IMPLICIT none
+      !
+      CHARACTER (LEN = 8), INTENT ( in) :: cdfldn ! Name of field to search for
+      INTEGER (kind=il), INTENT (  in) :: kdimax, knulre    ! Field dimension, unit to read
+      INTEGER (kind=il), INTENT (  in) :: kout              ! Standard output
+      INTEGER (kind=il), INTENT ( out) :: kflgre            ! Error status code
+      INTEGER (kind=il), INTENT ( inout), DIMENSION (:) :: kfield ! Field
+      !
+      CHARACTER (len = 8) :: clecfl
+      INTEGER (kind=il) :: ji, kerr
+      !
+      !*    1. Initialization
+      !        --------------
+      !
+      WRITE (UNIT = kout, FMT = '( "Locrint :  Read field ", A8, " in unit = ", 1I6, " Dim : ", 1I9)' ) cdfldn, knulre, kdimax
+      !
+      !     2. Find field in file
+      !        ------------------
+      !
+      REWIND ( UNIT = knulre )
+200   CONTINUE
+      !
+      !* Find string
+      READ (UNIT = knulre, ERR = 200, END = 210) clecfl
+!$$$    WRITE ( unit = kout, fmt = *) clecfl
+      !
+      IF ( clecfl /= cdfldn ) GO TO  200
+      !* Read associated field
+      READ (UNIT = knulre, IOSTAT = kerr) ( kfield (ji),ji = 1, kdimax)
+      IF ( kerr /= 0 ) WRITE ( unit = nout, fmt = *) 'Problem reading field'
+      !* Reading done and ok
+      kflgre = 0
+      GO TO 220
+      !* Problem in reading
+210   kflgre = 1
+      WRITE ( unit = nout, fmt = *) 'Problem in reading. ji : ', ji, kfield(1), kfield(kdimax)
+      !
+220   CONTINUE
+      !
+      !*    3. End of routine
+      !        --------------
+      !
+      RETURN
+   END SUBROUTINE locrint
+   !
+END PROGRAM interpol
Index: /TOOLS/MOZAIC/src/MOZAIC/inv_wei.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/inv_wei.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/inv_wei.f90	(revision 3326)
@@ -0,0 +1,420 @@
+! -*- Mode: f90 -*-
+PROGRAM inv_wei
+   !
+   USE defprec
+   USE data_types
+   USE fliocom
+   USE errioipsl
+   IMPLICIT NONE
+   !! Useful variables for initialisation
+   INTEGER (kind=il) :: nout=6 ! File number for messages
+   !!
+   !! Lit un fichier de poids IEEE, ecris les diags
+   !!
+   !! Partie à adapter à la résolution
+!-$$   CHARACTER (LEN=*), PARAMETER :: clname = '/home/data01/marti/CPL/FILES/ORCA2lgmxLMD9671/mozaic.wa2o.calvin.i4.r8'
+
+!-$$   CHARACTER (LEN=*), PARAMETER :: clname = 'mozaic.wa2o.i4.r8'
+!-$$   CHARACTER (LEN=8), PARAMETER :: clweight =  "WEIGHTS2", cladress = "ADRESSE2"
+!-$$   INTEGER (kind=il), PARAMETER :: jpi1=96 , jpj1=72 ! Dimensions modele 1
+!-$$   INTEGER (kind=il), PARAMETER :: jpi2=182, jpj2=149 ! Dimensions modele 2
+!-$$   INTEGER (kind=il), PARAMETER :: jp1to2 = 109, jp2to1 = 100 ! Nombre de voisins
+
+!-$$   CHARACTER (LEN=*), PARAMETER :: clname = 'mozaic.wa2o.runoff.i4.r8'
+!-$$   CHARACTER (LEN=8), PARAMETER :: clweight =  "WEIGHTS3", cladress = "ADRESSE3"
+!-$$   INTEGER (kind=il), PARAMETER :: jpi1=72 , jpj1=46 ! Dimensions modele 1
+!-$$   INTEGER (kind=il), PARAMETER :: jpi2=92, jpj2=76 ! Dimensions modele 2
+!-$$   INTEGER (kind=il), PARAMETER :: jp1to2 = 6, jp2to1 = 100 ! Nombre de voisins
+
+!-$$   CHARACTER (LEN=8), PARAMETER :: clweight =  "WEIGHTS5", cladress = "ADRESSE5"
+!-$$   INTEGER (kind=il), PARAMETER :: jpi1=96 , jpj1=72 ! Dimensions modele 1
+!-$$   INTEGER (kind=il), PARAMETER :: jpi2=182, jpj2=149 ! Dimensions modele 2
+!-$$   INTEGER (kind=il), PARAMETER :: jp1to2 = 36, jp2to1 = 10000 ! Nombre de voisins
+
+   CHARACTER (LEN=*), PARAMETER :: clname = 'mozaic.wa2o.runoff.i4.r8'
+   CHARACTER (LEN=8), PARAMETER :: clweight =  "WEIGHTS4", cladress = "ADRESSE4"
+   INTEGER (kind=il), PARAMETER :: jpi1=96 , jpj1=72   ! Dimensions modele 1
+   INTEGER (kind=il), PARAMETER :: jpi2=182, jpj2=149  ! Dimensions modele 2
+   INTEGER (kind=il), PARAMETER :: jp1to2 = 163, jp2to1 = 100 ! Nombre de voisins
+
+!-$$   CHARACTER (LEN=*), PARAMETER :: clname = 'mozaic.wa2o.runoff.i4.r8'
+!-$$   CHARACTER (LEN=8), PARAMETER :: clweight =  "WEIGHTS4", cladress = "ADRESSE4"
+!-$$   INTEGER (kind=il), PARAMETER :: jpi1=144, jpj1=144  ! Dimensions modele 1
+!-$$   INTEGER (kind=il), PARAMETER :: jpi2=182, jpj2=149  ! Dimensions modele 2
+!-$$   INTEGER (kind=il), PARAMETER :: jp1to2 = 7, jp2to1 = 100 ! Nombre de voisins
+
+   !!
+   INTEGER (kind=il), PARAMETER :: jp1 = jpi1 * jpj1, jp2 = jpi2 * jpj2  ! Dimensions
+   !!
+   REAL    (kind=rl), DIMENSION (jp1to2, jp2) :: w1to2
+   INTEGER (kind=il), DIMENSION (jp1to2, jp2) :: k1to2
+   INTEGER (kind=il), DIMENSION (jp2) :: nv1to2
+
+   REAL    (kind=rl), DIMENSION (jp2to1, jp1) :: w2to1
+   INTEGER (kind=il), DIMENSION (jp2to1, jp1) :: k2to1
+   INTEGER (kind=il), DIMENSION (jp1) :: nv2to1 
+
+   REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: w_t
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: k_t
+   REAL    (kind=rl), DIMENSION (:,:,:), ALLOCATABLE :: w_3d
+   INTEGER (kind=il), DIMENSION (:,:,:), ALLOCATABLE :: k_3d
+
+   INTEGER :: nwei8 = 23,  nc1, nc2
+
+   INTEGER (kind=il) :: ji1, jj1, ji2, jj2, j1, j2, jn1, jn2, ierr=0, jm1to2, jm2to1
+
+   ! Lecture des poids
+   OPEN (unit = nwei8, file = TRIM(clname), form = 'unformatted', status = 'old', action = 'read')
+   WRITE (nout, *) 'Fichier poids : ', TRIM (clname)
+
+   !!
+   WRITE (nout,*) 'Grille origine : ', jpi1, jpj1, jp1
+   WRITE (nout,*) 'Grille arrive  : ', jpi2, jpj2, jp2
+   WRITE (nout,*) 'Voisins 1 -> 2 : ', jp1to2
+   WRITE (nout,*) 'Voisins 2 -> 1 : ', jp2to1
+
+   ALLOCATE (k_t (jp1to2*jp2), STAT=ierr) ; CALL chka ("allocate k_t (jp1to2*jp2)", ierr)
+   WRITE (unit = nout, fmt = *) 'Will try to read : ', cladress
+   CALL locrint (cladress, k_t(1:jp1to2*jp2), jp1to2*jp2, nwei8, ierr, nout) ;  IF (ierr /= 0) STOP 201
+   k1to2 (1:jp1to2, 1:jp2) = RESHAPE (k_t (1:jp1to2 * jp2) , (/ jp1to2, jp2 /))
+   DEALLOCATE (k_t, STAT=ierr)  ; CALL chka ("deallocate k_t", ierr)
+
+   ALLOCATE (w_t (jp1to2*jp2), STAT=ierr) ; CALL chka ("allocate w_t (jp1to2*jp2)", ierr)
+   WRITE (unit = nout, fmt = *) 'Will try to read : ', clweight
+   CALL locread (clweight, w_t(1:jp1to2*jp2), jp1to2*jp2, nwei8, ierr, nout) ;  IF (ierr /= 0) STOP 201
+   w1to2 (1:jp1to2, 1:jp2) = RESHAPE (w_t (1:jp1to2 * jp2) , (/ jp1to2, jp2 /))
+   DEALLOCATE (w_t, STAT=ierr) ; CALL chka ("deallocate w_t", ierr)
+
+   nv1to2 = COUNT (k1to2 /= 0, DIM=1)
+   jm1to2 = MAXVAL (nv1to2)
+   WRITE (nout,*) 'nv1to2 : ', jm1to2
+   nv2to1 = 0_il
+   !!
+   ! Inversion
+   WRITE (nout,*) 'Start inversion '
+   DO j2 = 1, jp2 ! Boucle sur les points cibles
+      DO jn2 = 1, jp1to2 ! Boucle sur les voisins
+         j1 = k1to2 (jn2,j2) ! j1 : numéro du point sur la grille origine
+         IF (j1 == 0) CYCLE  ! 0 : pas de point cible
+         IF ( j1 > SIZE (nv2to1) ) WRITE (nout,*) 'Error - j1 (#1) ', j1
+         nv2to1 (j1) = nv2to1 (j1) + 1 ! On incremente le nombre de points cible trouvés
+         jn1 = nv2to1 (j1) 
+         IF (jn1 .GT. jp2to1) THEN ! 
+            WRITE(nout,*) 'Error - jn1, jp2to1, jn2, j1, j2 : ', jn1, jp2to1, jn2, j1, j2
+            STOP
+         END IF
+         IF ( jn1 > SIZE (k2to1, 1) ) WRITE (nout,*) 'Error - jn1 ', jn1
+         IF ( j1  > SIZE (k2to1, 2) ) WRITE (nout,*) 'Error - j1 (#2)', j1
+         k2to1 (jn1,j1) = j2
+         w2to1 (jn1,j1) = w1to2(jn2,j2)
+      END DO
+   END DO
+   jm2to1 = MAXVAL (nv2to1)
+   WRITE (nout, *) 'nv2to1 : ', jm2to1
+
+   ! Ecriture sur grille d'arrivee
+   !    CALL ipsldbg (new_status=.TRUE. )
+   !
+   CALL fliocrfd ('diag1to2.nc', (/'x   ', 'y   ', 'n   ' /), (/jpi2, jpj2, jm1to2/), nc2, mode='REPLACE')
+
+   CALL fliodefv (nc2, 'Weights_Max', (/1_il,2_il/), v_t=flio_r4, standard_name='Max weights')
+   CALL fliodefv (nc2, 'Neighbors'  , (/1_il,2_il/), v_t=flio_i4, standard_name='Neighbors')
+   CALL fliodefv (nc2, 'Weights_Sum', (/1_il,2_il/), v_t=flio_r4, standard_name='Sum weights')
+   CALL fliodefv (nc2, 'Weights', (/1_il,2_il,3_il/), v_t=flio_r4, standard_name='Weights')
+   CALL fliodefv (nc2, 'Adresses',(/1_il,2_il,3_il/), v_t=flio_i4, standard_name='Adresses')
+   CALL fliodefv (nc2, 'Index_I', (/1_il,2_il,3_il/), v_t=flio_i4 )
+   CALL fliodefv (nc2, 'Index_J', (/1_il,2_il,3_il/), v_t=flio_i4 )
+
+   CALL flioputv (nc2, 'Weights_Max', RESHAPE (MAXVAL(w1to2,DIM=1), (/jpi2, jpj2/)) )
+   CALL flioputv (nc2, 'Neighbors',   RESHAPE (MAX(0_il, nv1to2) , (/jpi2, jpj2/)) )
+   CALL flioputv (nc2, 'Weights_Sum', RESHAPE (SUM   (w1to2,DIM=1), (/jpi2, jpj2/)) )
+
+   ALLOCATE (w_3d(jpi2, jpj2, jm1to2))
+   ALLOCATE (k_3d(jpi2, jpj2, jm1to2))
+
+   DO jn2 = 1_il, jm1to2
+      DO jj2 = 1_il, jpj2
+         DO ji2 = 1_il, jpi2
+            w_3d (ji2, jj2, jn2) = REAL (w1to2 (jn2, m1_2(ji2, jj2)), KIND=rl)
+            k_3d (ji2, jj2, jn2) = INT  (k1to2 (jn2, m1_2(ji2, jj2)), KIND=il)
+         END DO
+      END DO
+   END DO
+   !
+   CALL flioputv (nc2, 'Weights' , w_3d(:,:,:) )
+   CALL flioputv (nc2, 'Adresses', k_3d(:,:,:) )
+   !
+   DEALLOCATE (w_3d) ; DEALLOCATE (k_3d)
+   CALL flioclo (nc2)
+
+   ! Ecriture sur grille de depart
+   ! CALL ipsldbg (new_status=.TRUE. )
+   !
+   CALL fliocrfd ('diag2to1.nc', (/'x   ', 'y   ', 'n   ' /), (/jpi1, jpj1, jm2to1 /), nc1, mode='REPLACE')
+
+   CALL fliodefv (nc1, 'Weights_Max', (/1_il,2_il/), v_t=flio_r4, standard_name='Max weights')
+   CALL fliodefv (nc1, 'Neighbors'  , (/1_il,2_il/) , v_t=flio_i4, standard_name='Neighbors')
+   CALL fliodefv (nc1, 'Weights_Sum', (/1_il,2_il/) , v_t=flio_r4, standard_name='Sum weights')
+   CALL fliodefv (nc1, 'Weights', (/1_il,2_il,3_il/), v_t=flio_r4, standard_name='Weights')
+   CALL fliodefv (nc1, 'Adresses',(/1_il,2_il,3_il/), v_t=flio_i4, standard_name='Adresses')
+   CALL fliodefv (nc1, 'Index_I', (/1_il,2_il,3_il/), v_t=flio_i4 )
+   CALL fliodefv (nc1, 'Index_J', (/1_il,2_il,3_il/), v_t=flio_i4 )
+
+   CALL flioputv (nc1, 'Weights_Max', RESHAPE (MAXVAL(w2to1,DIM=1), (/jpi1, jpj1/)) )
+   CALL flioputv (nc1, 'Neighbors',   RESHAPE (MAX   (0_il, nv2to1), (/jpi1, jpj1/)) )
+   CALL flioputv (nc1, 'Weights_Sum', RESHAPE (SUM   (w2to1,DIM=1), (/jpi1, jpj1/)) )
+
+   ALLOCATE (w_3d(jpi1, jpj1, jm2to1))
+   ALLOCATE (k_3d(jpi1, jpj1, jm2to1))
+
+   DO jn1 = 1_il, jm2to1
+      DO jj1 = 1_il, jpj1
+         DO ji1 = 1_il, jpi1
+            w_3d (ji1, jj1, jn1) = REAL (w2to1 (jn1, m1_1(ji1, jj1)), KIND=rl)
+            k_3d (ji1, jj1, jn1) = INT  (k2to1 (jn1, m1_1(ji1, jj1)), KIND=il)
+         END DO
+      END DO
+   END DO
+   !
+   CALL flioputv (nc1, 'Weights' , w_3d(:,:,:))
+   CALL flioputv (nc1, 'Adresses', k_3d(:,:,:))
+   !
+   DEALLOCATE (w_3d) ; DEALLOCATE (k_3d)
+   CALL flioclo (nc1)
+   !
+CONTAINS
+   !!
+   SUBROUTINE chka (clmess, kerr)
+      IMPLICIT NONE
+      CHARACTER (len=*), INTENT (in) :: clmess
+      INTEGER (kind=il), INTENT (in) :: kerr
+      LOGICAL :: l_deb = .TRUE.
+      !!
+      IF (kerr == 0) THEN 
+         IF (l_deb) THEN
+            WRITE (nout,*) "OK : ", TRIM (clmess)
+         END IF
+      ELSE
+         WRITE (nout,*) "ERROR # ", kerr, " : ", TRIM (clmess)
+      END IF
+   END SUBROUTINE chka
+   !!
+   ELEMENTAL FUNCTION m2i1 (k1) ! 2D indexes from 1D, grille 1
+      IMPLICIT NONE
+      INTEGER (kind=il) :: m2i1
+      INTEGER (kind=il), INTENT (in) :: k1
+      IF (k1 == 0_il ) THEN 
+         m2i1 = 0_il
+      ELSE
+         m2i1 = MOD (k1 - 1_il, jpi1) + 1_il
+      END IF
+      RETURN
+   END FUNCTION m2i1
+   ELEMENTAL FUNCTION m2j1 (k1)
+      IMPLICIT NONE
+      INTEGER (kind=il) :: m2j1
+      INTEGER (kind=il), INTENT (in) :: k1
+      IF (k1 == 0_il ) THEN 
+         m2j1 = 0_il
+      ELSE
+         m2j1 = (k1 - 1_il) / jpi1 + 1_il
+      END IF
+      RETURN
+   END FUNCTION m2j1
+   ELEMENTAL FUNCTION m2i2 (k2) ! 2D indexes from 1D, grille 2
+      IMPLICIT NONE
+      INTEGER (kind=il) :: m2i2
+      INTEGER (kind=il), INTENT (in) :: k2
+      IF (k2 == 0_il ) THEN 
+         m2i2 = 0_il
+      ELSE 
+         m2i2 = MOD (k2 - 1_il, jpi2) + 1_il
+      END IF
+      RETURN
+   END FUNCTION m2i2
+   ELEMENTAL FUNCTION m2j2 (k2)
+      IMPLICIT NONE
+      INTEGER (kind=il) :: m2j2
+      INTEGER (kind=il), INTENT (in) :: k2
+      IF (k2 == 0_il ) THEN 
+         m2j2 = 0_il
+      ELSE 
+         m2j2 = (k2 - 1_il) / jpi2 + 1_il
+      END IF
+      RETURN
+   END FUNCTION m2j2
+   ELEMENTAL FUNCTION m1_2 (ki2, kj2)  ! 1D indexes from 2D, grille 2
+      IMPLICIT NONE
+      INTEGER (kind=il) :: m1_2
+      INTEGER (kind=il), INTENT (in) :: ki2, kj2
+      m1_2 = ki2 + (kj2 - 1_il) * jpi2
+      RETURN
+   END FUNCTION m1_2
+   ELEMENTAL FUNCTION m1_1 (ki1, kj1)  ! 1D indexes from 2D, grille 1
+      IMPLICIT NONE
+      INTEGER (kind=il) :: m1_1
+      INTEGER (kind=il), INTENT (in) :: ki1, kj1
+      m1_1 = ki1 + (kj1 - 1_il) * jpi1
+      RETURN
+   END FUNCTION m1_1
+   !
+   SUBROUTINE locread (cdfldn, pfield, kdimax, knulre, kflgre, kout)
+      !
+      !     Purpose:
+      !     -------
+      !     Find string cdfldn on unit knulre and read array pfield
+      !
+      !     Reference:
+      !     ---------
+      !     See OASIS manual (1995) 
+      !
+      !     History:
+      !     -------
+      !       Version   Programmer     Date      Description
+      !       -------   ----------     ----      -----------  
+      !       2.0       L. Terray      95/09/01  created
+      !
+      ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER (len = 8), INTENT (in) :: cdfldn ! Name of field to search for
+      INTEGER (kind=il), INTENT ( in) :: kdimax, knulre    ! Field dimension, unit to read
+      INTEGER (kind=il), INTENT ( in) :: kout              ! Standard output
+      INTEGER (kind=il), INTENT (out) :: kflgre            ! Error status code
+      REAL (kind=rl)  , INTENT (out), DIMENSION (:) :: pfield ! Field
+      REAL (kind=rk_in), DIMENSION (:), ALLOCATABLE :: ztemp
+      INTEGER (kind=il) :: ki
+      !
+      CHARACTER (len = 8) clecfl
+      INTEGER (kind=il) :: kerr
+      !
+      !*    1. Initialization
+      !        --------------
+      !
+      WRITE (UNIT = kout, FMT = '("Locread :  Read field ", A8, " in unit = ", 1I3, " Dim : ", 1I8)' ) cdfldn, knulre, kdimax
+      kerr = 0 ; ki = -1
+      !
+      !     2. Find field in file
+      !        ------------------
+      IF (ALLOCATED (ztemp)) DEALLOCATE (ztemp)
+      ALLOCATE (ztemp (1: kdimax), STAT = kerr )
+      IF (kerr /= 0 ) THEN 
+         WRITE (kout, *) 'Locread - Error allocating ztemp : ', kerr
+         kflgre = kerr
+         RETURN
+      END IF
+      !
+      REWIND (UNIT = knulre)
+200   CONTINUE
+      !* Find string
+      READ (UNIT = knulre, ERR = 200, END = 210) clecfl
+      IF (clecfl /= cdfldn ) GO TO  200
+      !* Read associated field
+      WRITE (unit = kout, fmt = *) 'Locread - Field found : ', clecfl
+      !$$$    READ (UNIT = knulre, IOSTAT = kerr, ERR = 210, END = 210 ) ztemp (1: kdimax)
+      !$$$    READ (UNIT = knulre, ERR = 210, END = 210 ) ztemp (1: kdimax)
+      ki = -2
+      READ (UNIT = knulre, ERR = 210, END = 210 ) (ztemp (ki), ki = 1, kdimax)
+      IF (kerr == 0 ) THEN 
+         !* Reading done and ok
+         pfield (1: kdimax) = REAL (ztemp (1: kdimax), KIND = rl )
+         kflgre = 0
+      ELSE 
+         WRITE (unit = kout, fmt = *) 'Locread - Problem reading field ', cdfldn, kdimax, ki
+         kflgre = 1
+      END IF
+      GO TO 220
+      !* Problem in reading
+210   kflgre = 1
+      WRITE (unit = kout, fmt = *) 'Locread - Problem in reading ', cdfldn, kdimax, ki
+220   CONTINUE
+      !
+      DEALLOCATE (ztemp)
+      !
+      !*    3. End of routine
+      !        --------------
+      !
+      RETURN
+   END SUBROUTINE locread
+   !
+   SUBROUTINE locrint (cdfldn, kfield, kdimax, knulre, kflgre, kout)
+      !
+      !     Purpose:
+      !     -------
+      !     Find string cdfldn on unit knulre and read integer array pfield
+      !
+      !     Reference:
+      !     ---------
+      !     See OASIS manual (1995) 
+      !
+      !     History:
+      !     -------
+      !       Version   Programmer     Date      Description
+      !       -------   ----------     ----      -----------  
+      !       2.0       L. Terray      95/09/01  created
+      !
+      ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      !
+      IMPLICIT none
+      !
+      CHARACTER (LEN = 8), INTENT (in) :: cdfldn ! Name of field to search for
+      INTEGER (kind=il), INTENT (in) :: kdimax, knulre    ! Field dimension, unit to read
+      INTEGER (kind=il), INTENT (in) :: kout              ! Standard output
+      INTEGER (kind=il), INTENT (out) :: kflgre            ! Error status code
+      INTEGER (kind=il), INTENT (inout), DIMENSION (:) :: kfield ! Field
+      INTEGER (kind=ik_in), DIMENSION (:), ALLOCATABLE :: itemp
+      INTEGER (kind=il) :: ji
+      !
+      CHARACTER (len = 8) :: clecfl
+      INTEGER (kind=il) :: kerr
+      !
+      !*    1. Initialization
+      !        --------------
+      !
+      WRITE (UNIT = kout, FMT = '("Locrint :  Read field ", A8, " in unit = ", 1I3, " Dim : ", 1I8)' ) cdfldn, knulre, kdimax
+      !
+      !     2. Find field in file
+      !        ------------------
+      IF (ALLOCATED (itemp)) DEALLOCATE (itemp)
+      ALLOCATE (itemp (1: kdimax), STAT = kerr )
+      IF (kerr /= 0 ) THEN 
+         WRITE (kout, *) 'Locrint - Error allocating itemp in locrint : ', kerr
+         kflgre = kerr
+         RETURN
+      END IF
+      !
+      REWIND (UNIT = knulre )
+200   CONTINUE
+      !
+      !* Find string
+      READ (UNIT = knulre, ERR = 200, END = 210) clecfl
+      IF (clecfl /= cdfldn ) GO TO  200
+      !* Read associated field
+      WRITE (UNIT = kout, FMT= *) 'Locrint - Field found ', clecfl
+      !$$$    READ (UNIT = knulre, END = 210, IOSTAT = kerr) (itemp (ji), ji = 1, kdimax)
+      READ (UNIT = knulre, END = 210) (itemp (ji), ji = 1, kdimax)
+      IF (kerr == 0 ) THEN 
+         !* Reading done and ok
+         kfield (1: kdimax) = INT (itemp (1: kdimax), KIND = il)
+         kflgre = 0
+      ELSE 
+         WRITE (unit = kout, fmt = *) 'Locrint - Problem reading field ', cdfldn, kdimax, ji
+         kflgre = 1
+      END IF
+      GO TO 220
+      !* Problem in reading
+210   kflgre = 1
+      WRITE (unit = kout, fmt = *) 'Locrint - Problem in reading ', cdfldn, kdimax, ji
+      !
+220   CONTINUE
+      !
+      DEALLOCATE (itemp)
+      !
+      !*    3. End of routine
+      !        --------------
+      !
+      RETURN
+   END SUBROUTINE locrint
+   !!
+END PROGRAM inv_wei
Index: /TOOLS/MOZAIC/src/MOZAIC/isf_icb.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/isf_icb.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/isf_icb.f90	(revision 3326)
@@ -0,0 +1,475 @@
+! -*- Mode: f90 -*-
+PROGRAM isf_icb
+   USE declare
+   USE modeles
+   USE mod_lecdata
+   USE formula
+   USE math
+   USE mod_rectifie
+   USE mod_lbc
+   USE bords
+   USE mod_prih
+   USE mod_wri_wei
+   USE fliocom
+   USE errioipsl
+   USE getincom
+   USE mod_inipar
+   USE mod_inter
+!!!
+   IMPLICIT NONE
+!!!
+!!! Calcul pour poids pour le calving qui va aller dans les parametrisations isf et icb de NEMO.
+!!!
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: ynorth, ysouth
+   REAL (kind=rl), PARAMETER :: zm_frac = 0.0_rl ! Fraction criterium
+   !!
+   INTEGER (kind=il) :: ja, jo, jn, joi, joj, jai, jaj, jr, kn ! indices de boucle
+   INTEGER (kind=il), DIMENSION (:, :), ALLOCATABLE :: imask ! Masque
+   REAL (kind=rl)    :: zosrf, zasrf ! Surface totale
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zasrf_lat ! Surface atmosphere par bande de latitude
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: wtemp, rnf_key
+   REAL(kind=rl), DIMENSION (:, :), ALLOCATABLE  :: z2o
+   CHARACTER (len=80) :: cfname4, cfname8, cfname_cdf
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE  :: i2a
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE  :: i2o
+   CHARACTER (len=50) :: cldiag_a2o, clw_a2o, clw_a2o_cdf, clw_a2o_mct, c_poids, calving_name
+   INTEGER (kind=il) :: ierr, il_icb
+   LOGICAL :: l_no_pac, l_compute, l_iceshelf, l_iceberg, l_standard
+   REAL (kind=rl), DIMENSION (:,:)  , ALLOCATABLE  :: w2d
+   REAL (kind=rl), DIMENSION (:,:,:), ALLOCATABLE  :: w3d
+   REAL(kind=rl) :: rnf_key_sum
+   !!
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   INTEGER (kind=i_4) :: il_ncid
+   CHARACTER (len=40) :: cl_bassin, cpoids
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: tmask_atl, tmask_noclose, tmask_nomed, tmask_med
+   !!
+   CHARACTER (len = 25) :: mo_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   !!
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 1 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   CALL inipar
+   CALL alloc_modeles
+   !!
+   !! Initialisation
+   !!
+   ! Lecture sur la ligne de commande du calcul Ã  faire
+   CALL getarg ( 2, c_poids)
+   WRITE (nout,*) 'Calcul a faire : ', TRIM(c_poids)
+   SELECT CASE ( TRIM(c_poids))
+   CASE ( 'iceshelf'        ) ; calving_name = 'calving_iceshelf'
+   CASE ( 'iceberg'         ) ; calving_name = 'calving_iceberg'
+   CASE ( 'calving_nosouth' ) ; calving_name = 'calving_nosouth'
+   CASE ( 'calving_full'    ) ; calving_name = 'calving_full'
+   CASE Default
+      WRITE (nout,*) 'Cas non reconnu'
+      STOP
+   END SELECT
+   
+   ALLOCATE (imask (jpon, jp_calv), STAT=ierr)    ; CALL chk_allo (ierr, 'imask', lreset=.TRUE., crout='icestream')
+   ALLOCATE (zasrf_lat (jpaj), STAT=ierr)     ; CALL chk_allo (ierr, 'zasrf_lat')
+   ALLOCATE (wtemp (jpa2o), STAT=ierr)        ; CALL chk_allo (ierr, 'wtemp')
+   ALLOCATE (ktemp (jpa2o), STAT=ierr)        ; CALL chk_allo (ierr, 'ktemp')
+   ALLOCATE (z2o (jpoi, jpoj), STAT=ierr)     ; CALL chk_allo (ierr, 'z2o')
+   ALLOCATE (i2a (jpai, jpaj), STAT=ierr)     ; CALL chk_allo (ierr, 'i2a')
+   ALLOCATE (i2o (jpoi, jpoj), STAT=ierr)     ; CALL chk_allo (ierr, 'i2o')
+   ALLOCATE (tmask_atl     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_atl')
+   ALLOCATE (tmask_noclose (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_noclose')
+   ALLOCATE (tmask_nomed   (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmasl_nomed')
+   ALLOCATE (tmask_med     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'tmask_med')
+   ALLOCATE (rnf_key       (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'rnf_key')
+   !!
+   ALLOCATE (ynorth (1:jp_calv), STAT=ierr) ; CALL chk_allo (ierr, 'ynorth')
+   ALLOCATE (ysouth (1:jp_calv), STAT=ierr) ; CALL chk_allo (ierr, 'ynorth')
+   !!
+   ysouth (1:jp_calv) = ylimits (1:jp_calv)
+   ynorth (1:jp_calv) = ylimits (2:jp_calv+1)
+   !!
+   !! Initialisation
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13 ; nchk = 14 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 21 ; nwei8o2a = 22 ; nwei4a2o = 23 ; nwei8a2o = 24
+   !
+   nout = 0
+   IF (nout /= 6 .AND. nout /= 0 ) THEN
+      OPEN (unit = nout, file = 'icestream' // TRIM(c_suffix) // '.out', action = 'write', status = 'unknown', position = 'rewind' )
+   END IF
+   !
+   jma2o = 0_il
+   jmo2a = 0_il
+   nvo = 0_il
+   !!
+   !! Read coordinates of all models, and weights
+   !!
+   CALL lecdata (lecweights = .FALSE., leco2amask = .TRUE. )
+   !!
+   wa2o = zero
+   ka2o = 0_il
+   !
+!    CALL ipsldbg (.TRUE. )
+   !
+   WRITE (nout,*) 'Periodicite'
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+   CALL lbc (xalont, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalonu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalonv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !!
+   WRITE (nout,*) 'Rectifie'
+   CALL rectifie
+   !!
+   WRITE (nout,*) 'Calcul de la surface par bande de latitude atmosphere'
+   zasrf_lat(:) = 0.0_rl
+   DO jaj = 1_il, jpaj
+      DO jai = 1_il, jpai
+         ja = m1a(jai, jaj)
+         zasrf_lat(jaj) = zasrf_lat(jaj) + xasrft(ja)
+      END DO
+   ENDDO
+   DO jaj = 1, jpaj
+      WRITE(UNIT=nout,FMT='(1F7.1,1PE15.3)' ) xalatt ( m1a (1_il, jaj)), zasrf_lat (jaj)
+   END DO
+   WRITE(nout,*) SUM (zasrf_lat)
+   !!
+   CALL bord_a
+   !!
+   mo_name  = "mozaic"
+   a2o_name = "a2o"
+   !!
+   WRITE (nout,*) 'bord_o'
+   CALL bord_o
+   WRITE (nout,*) 'bord_a'
+   CALL bord_oa
+   !!
+   WRITE (nout,*) 'o2amask ', COUNT (o2amask > 0 ), COUNT (o2amask <=  0 )
+   i2a = 0_il
+   WHERE (RESHAPE(o2amask,(/jpai,jpaj/)) .GT. 0.0_rl ) i2a = 1_il
+   !CALL prihin (i2a , 1_il, nout )
+   !!
+   !! Lecture masques de bassin
+   IF ( TRIM (cotyp) == 'orca2' .OR. TRIM (cotyp) == 'orca2.0' .OR. TRIM (cotyp) == 'orca2.1' .OR. TRIM (cotyp) == 'orca4' ) THEN 
+      cl_bassin = TRIM (cotyp)
+!-$$      IF (c_period /= 'none' ) cl_bassin = TRIM (cl_bassin) // TRIM (c_period)
+      cl_bassin = TRIM (cl_bassin) // '.nc'
+      CALL flioopfd (TRIM (cl_bassin), il_ncid )
+      CALL fliogetv (il_ncid, 'mask_atl'    , z2o )
+      tmask_atl = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_noclose', z2o )
+      tmask_noclose = RESHAPE (z2o, (/ jpon /) )
+      CALL fliogetv (il_ncid, 'mask_nomed'  , z2o )
+      tmask_nomed = RESHAPE (z2o, (/ jpon /) )
+      CALL flioclo (il_ncid)
+   ELSE
+      tmask_atl     = REAL (1-iomskt, rl)
+      tmask_noclose = REAL (1-iomskt, rl)
+      tmask_nomed   = REAL (1-iomskt, rl)
+   END IF
+   !
+   WRITE (unit=nout, fmt=*) 'iomskt'
+   !CALL prihin (RESHAPE(iomskt             ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_atl'
+   !CALL prihin (RESHAPE(NINT(tmask_atl)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_med'
+   !CALL prihin (RESHAPE(NINT(tmask_med)    ,(/jpoi,jpoj/)), 1_il, nout)
+   WRITE (unit=nout, fmt=*) 'tmask_noclose'
+   !CALL prihin (RESHAPE(NINT(tmask_noclose),(/jpoi,jpoj/)), 1_il, nout)
+   !
+   Bassin: DO jr = 1_il, jp_calv !! Boucle sur les zones
+      WRITE (nout,*) '==================================================================='
+      WRITE (nout,*) 'Zone : ', jr, ' sud: ', ysouth(jr), '  nord : ', ynorth(jr)
+      !!
+      !! Creation du masque
+      !!
+      imask (:,jr) = 1_il
+      !!
+      tmask_med = 0.0_r_4
+      WHERE (tmask_atl > 0.5_r_4 .AND. tmask_nomed < 0.5_r_4 ) tmask_med = 1.0_r_4
+
+      ! Limite nord incluse, limite sud exclue
+      ! Ne pas faire pour la bande sud dans le cas iceberg, car les icebergs vont plus loin au nord
+      IF ( jr == 1 .AND.  TRIM (c_poids) == 'iceberg' ) THEN
+         WHERE (tmask_noclose > 0.5_r_4 .AND. xolatt < -10.0_rl ) imask(:,jr) = iomskt
+      ELSE
+         WHERE (tmask_noclose > 0.5_r_4 .AND. (xolatt > ysouth (jr) .AND. xolatt <= ynorth (jr)) ) imask(:,jr) = iomskt
+         WHERE (tmask_med (:) > 0.5_rl ) imask (:,jr) = 1_il
+         IF (l_no_pac) WHERE (tmask_atl (:) < 0.5_rl .AND. xolatt > ysouth (jp_calv) )  imask (:,jr) = 1_il
+      ENDIF
+      !!
+      WRITE(nout,*) 'Bassin ', jr
+      i2o =  RESHAPE ( imask(:,jr), (/jpoi, jpoj/))
+      !CALL prihin (i2o, 1_il, nout)
+      !!
+      WRITE (nout,*) 'Calcul de la surface totale de la zone ocean'
+      zosrf = DOT_PRODUCT (xosrft, REAL(1-imask(:,jr),KIND=rl)*REAL(1-iomskp,KIND=rl) )
+      WRITE(nout,*) 'Surface de la zone ', jr, zosrf
+      !!
+      !! Calcul de la surface totale de la zone atmosphere
+      zasrf = 0.0_rl
+      DO ja = 1, jpan
+         IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) zasrf = zasrf + xasrft(ja)
+      END DO
+      !!
+      l_compute = .FALSE. ; l_iceshelf = .FALSE. ; l_iceberg = .FALSE. ; l_standard = .FALSE.
+      IF ( ysouth(jr) .LE. -89.0_rl ) THEN
+         IF (      TRIM(c_poids) == 'iceshelf'        ) THEN
+            l_iceshelf = .TRUE. ; l_compute = .TRUE.
+         ELSE IF ( TRIM(c_poids) == 'iceberg'         ) THEN
+            l_iceberg  = .TRUE. ; l_compute = .TRUE.
+         ELSE IF ( TRIM(c_poids) == 'calving_nosouth' ) THEN
+            l_compute = .FALSE.
+         ELSE
+            l_compute = .TRUE. ; l_standard = .TRUE. 
+         END IF
+      ELSE
+         IF (      TRIM(c_poids) == 'iceshelf'  .OR. TRIM (c_poids) == 'iceberg'         ) THEN
+            l_compute = .FALSE.
+         ELSE
+            l_compute = .TRUE. ; l_standard = .TRUE. 
+         END IF
+      END IF
+      
+      !!
+      !! Calcul des poids
+      Compute: IF ( l_compute ) THEN
+         Sud: IF ( l_iceberg .OR. l_iceshelf ) THEN
+            WRITE (nout,*) 'Calcul des poids : Antarctique : ', TRIM(c_poids)
+            ! Lecture des donnÃ©es de de fonte des ice shelf autour de l'Antarctique et de fonte d'iceberg
+            CALL flioopfd ('runoff-icb_DaiTrenberth_Depoorter_eORCA1_JD.nc', il_icb)
+            ALLOCATE ( w3d (jpoi, jpoj, 12))
+            ALLOCATE ( w2d (jpoi, jpoj))
+            IF ( l_iceshelf ) CALL fliogetv (il_icb, 'sornfisf', w3d(:,:,:))
+            IF ( l_iceberg  ) CALL fliogetv (il_icb, 'Icb_flux', w3d(:,:,:))
+            w2d (:,:) = SUM ( w3d(:,:,:), DIM=3)
+            !
+            !WRITE (nout,*) 'champ avant rescale ' 
+            !CALL prihre (w2d (:,:), 0.0, nout )
+            !
+            rnf_key (:) = RESHAPE ( w2d, (/ jpon /))
+            DEALLOCATE (w2d) ; DEALLOCATE (w3d)
+            CALL flioclo ( il_icb)
+            !
+            ! Integrale du flux
+            rnf_key_sum = SUM ( rnf_key(:)*xosrft(:)*REAL(1- imask(:,jr),KIND=rl)*REAL(1-iomskp,KIND=rl) )
+            WRITE (nout,*) 'Somme ',  TRIM(c_poids), ' : ', rnf_key_sum
+            ! Normalisation
+            rnf_key (:) = rnf_key (:) * zosrf / rnf_key_sum * REAL(1- imask(:,jr),KIND=rl)
+            CALL lbc (rnf_key (:) , noperio, 'T', jpoi, jpoj)
+            !
+            !WRITE (nout,*) 'champ apres rescale ' 
+            !CALL prihre ( RESHAPE(rnf_key (:), (/jpoi,jpoj/)), 0.0, nout)
+            !
+            WRITE (nout,*) 'Verif somme   : ', SUM ( rnf_key(:) )
+            WRITE (nout,*) 'Verif min/max : ', MINVAL ( rnf_key(:)), MAXVAL ( rnf_key(:))
+            WRITE (nout,*) 'Verif somme   : ', SUM ( xosrft(:)*REAL(1- imask(:,jr),KIND=rl)*REAL(1-iomskp,KIND=rl) ), SUM ( rnf_key(:) * xosrft(:)*REAL(1- imask(:,jr),KIND=rl)*REAL(1-iomskp,KIND=rl) )
+            !
+            DO jo = 1, jpon ! Boucle sur tous les points ocean
+               IF (imask(jo,jr) == 0_il ) THEN ! Vrai si le point NEMO est un point ocean dans la bande de latitude
+                  DO jaj = 1_il, jpaj ! Boucle sur les latitudes atmosphere
+                     ja = m1a(1_il, jaj) ! Indice 1D du point le plus Ã  l'ouest
+                     IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) THEN ! Test si le point atmosphere est dans la bande de latitude
+                        nvo (jo) = nvo (jo) + 1 ! Increment du nombre de voisins
+                        IF (nvo(jo) .GT. jpa2o ) THEN ! Test sur le nombre maximum de voisin
+                           WRITE (nout,*) 'Nombre de voisins insuffisant ', jpa2o
+                           WRITE (nout,*) jr, jo, ja, xalatt(ja), ysouth(jr), ynorth(jr)
+                           STOP
+                        END IF
+                        ka2o (nvo(jo), jo) = ja
+                        wa2o (nvo(jo), jo) = zasrf_lat(jaj) / zosrf * rnf_key(jo)
+                     END IF
+                  END DO
+               END IF
+            END DO
+         ELSE IF ( l_standard) THEN
+            WRITE (nout,*) 'Cas standard'
+            WRITE (nout,*) 'Calcul des poids ',  ysouth(jr), ynorth(jr)
+            DO jo = 1, jpon ! Boucle sur tous les points ocean
+               IF (imask(jo,jr) == 0_il ) THEN ! Vrai si le point NEMO est un point ocean dans la bande de latitude
+                  DO jaj = 1_il, jpaj ! Boucle sur les latitudes atmosphere
+                     ja = m1a(1_il, jaj) ! Indice 1D du point le plus Ã  l'ouest
+                     IF ( xalatt(ja) > ysouth(jr) .AND. xalatt(ja) <= ynorth(jr)) THEN ! Test si le point atmosphere est dans la bande de latitude
+                        nvo (jo) = nvo (jo) + 1 ! Increment du nombre de voisins
+                        IF (nvo(jo) .GT. jpa2o ) THEN ! Test sur le nombre maximum de voisin
+                           WRITE (nout,*) 'Nombre de voisins insuffisant ', jpa2o
+                           WRITE (nout,*) jr, jo, ja, xalatt(ja), ysouth(jr), ynorth(jr)
+                           STOP
+                        END IF
+                        ka2o (nvo(jo), jo) = ja
+                        wa2o (nvo(jo), jo) = zasrf_lat(jaj) / zosrf ! Division par la surface totale de la zone ocÃ©anique
+                     ENDIF
+                  ENDDO
+               END IF
+            END DO
+            !!
+         ELSE
+            WRITE (nout,*) 'On ne fait rien, et on ne devrait pas passer par la ... !'
+            STOP
+         END IF Sud
+      ELSE
+         WRITE (nout,*) 'On ne fait rien'
+      END IF Compute
+      jma2o = MAXVAL (nvo)
+      WRITE (nout,*) 'jma2o, first guess : ', jma2o
+      !!
+   END DO Bassin
+   !!
+   WRITE (nout,*) '==================================================================='
+   !!
+   WRITE(nout, *) 'jma2o : ', jma2o
+   !!
+   ! Tests bassins
+!-$$   WRITE(nout,*) 'Somme des bassins '
+!-$$   i2o =  RESHAPE (SUM(1-imask,DIM=2)*(1-iomskp), (/jpoi, jpoj/) )
+!-$$   CALL prihin (i2o, 1_il, nout)
+!-$$   !
+!-$$   WRITE(nout,*) 'Somme des bassins '
+!-$$   i2o =  RESHAPE ((1-iomskt)-SUM(1-imask,DIM=2)*(1-iomskp), (/jpoi, jpoj/) )
+!-$$   CALL prihin (i2o, 1_il, nout)
+!-$$   !
+!-$$   WRITE(nout,*) 'Somme des bassins '
+!-$$   i2o =  RESHAPE (SUM(imask,DIM=2), (/jpoi, jpoj/))
+!-$$   CALL prihin (i2o, 1_il, nout)
+   !!
+   !! Normalisation
+   !!
+!$$$      WRITE (nout, *) 'wa2o ', MINVAL (wa2o), MAXVAL (wa2o), COUNT (wa2o > 0.0_rl)
+!$$$      WRITE (nout, *) 'ka2o ', MINVAL (ka2o), MAXVAL (ka2o), COUNT (ka2o > 0 )
+!$$$      WRITE (nout, *) 'xasrft ', MINVAL (xasrft), MAXVAL (xasrft)
+!$$$      WRITE (nout, *) 'o2amask ', MINVAL (o2amask), MAXVAL (o2amask), SUM (o2amask)
+!$$$      WRITE (nout, *) 'xosrft ', MINVAL (xosrft), MAXVAL (xosrft)
+!$$$      WRITE (nout, *) 'iomskt ', MINVAL (iomskt), MAXVAL (iomskt), COUNT (iomskt == 0)
+!$$$      WRITE (nout, *) 'iomskp ', MINVAL (iomskp), MAXVAL (iomskp), COUNT (iomskp == 0)
+!$$$      WRITE (nout, *) 'iamskt ', MINVAL (iamskt), MAXVAL (iamskt), COUNT (iamskt == 0)
+!$$$      WRITE (nout, *) 'locot ', COUNT (locot)
+   !!
+   WRITE(nout,*) 'gather weights'
+   !CALL gather_wei
+   !!
+   WRITE(nout,*) 'Checking weights'
+   WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9  )' ) MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+   WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9  )' ) MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+   jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o mini : ", 4I6, 1E13.4, 3I6)' ) &
+      & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+   jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jn = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 4I6, 1E13.4, 3I6)' ) &
+      & jo, jn, joi, joj, wa2o(jn,jo), ka2o(jn,jo), m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo))
+   !
+   jind(1:1) = INT(MAXLOC (nvo),il) ; jo = jind(1)
+   WRITE (unit = nout, fmt = *) jo, m2oi(jo), m2oj(jo), ka2o(1:nvo(jo),jo), &
+      & (m2ai(ka2o(jn,jo)), m2aj(ka2o(jn,jo)), jn = 1, nvo(jo))
+   !!
+   WRITE(nout,*) 'Calcul du masque'
+   CALL inter_a2o (REAL (1-iamskt, KIND = rl), a2omask)
+   !!
+!-$$   za = 1.0_rl
+!-$$   CALL inter_a2o (za, zo)
+!-$$   !
+!-$$   zsuma = DOT_PRODUCT (za, xasrft*o2amask)
+   
+   !!
+!-$$   WRITE(nout,*) 'Verif nombre de voisins'
+!-$$   !!
+!-$$   IF ( jma2oi /= jma2o ) THEN 
+!-$$      WRITE (nout, *) 'Erreur nombre de voisins dans run.def : '
+!-$$      WRITE (nout, *) ' jma2o calcule : ', jma2o
+!-$$      WRITE (nout, *) ' jma2o lu      : ', jma2oi
+!-$$      STOP
+!-$$   ENDIF
+   !!
+   WRITE(nout,*) 'Ecriture des poids'
+   !!
+   WRITE (unit = c_r, fmt = '(1i1)' ) rk_out
+
+   SELECT CASE ( TRIM(c_poids))
+   CASE ( 'iceshelf'        ) ; calving_name = 'calving_iceshelf'
+   CASE ( 'iceberg'         ) ; calving_name = 'calving_iceberg'
+   CASE ( 'calving_nosouth' ) ; calving_name = 'calving_nosouth'
+   CASE ( 'calving_full'    ) ; calving_name = 'calving_full'
+   END SELECT
+   
+   IF (l_wei_i4) THEN 
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_4
+      cfname4 = TRIM(mo_name) // ".wa2o." // TRIM(calving_name) // TRIM(c_suffix)  // ".i" // TRIM(c_i) // ".r" // TRIM(c_r) 
+      OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace', action = 'write')
+      WRITE (nout, *) 'Poids i_4 a -> o : ', TRIM(cfname4)
+   END IF
+
+   IF (l_wei_i8) THEN
+      WRITE (unit = c_i, fmt = '(1i1)' ) i_8
+      cfname8 = TRIM(mo_name) // ".wa2o." // TRIM(calving_name) // TRIM(c_suffix) // ".i" // TRIM(c_i)  // ".r" // TRIM(c_r)
+      OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace', action = 'write')
+      WRITE (nout, *) 'Poids i_8 a -> o : ', TRIM(cfname8)
+   END IF
+
+   cldiag_a2o  = TRIM(a2o_name) // "." // TRIM(calving_name)  // ".diag" ! // TRIM(c_suffix) // ".nc"
+   clw_a2o     = "mozaic.wa2o." // TRIM(calving_name) // TRIM(c_suffix)
+   clw_a2o_mct = "rmp_" // TRIM(camod_t) // "_to_" // TRIM(comod_t) // "_MOSAIC_" // TRIM(calving_name) ! // TRIM(c_suffix) // ".nc"
+
+   WRITE (nout, *) 'Calling wri_weights_a2o ', cldiag_a2o, clw_a2o, "5"
+   CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "5" )      
+
+   IF (l_wei_i4) CLOSE (unit = nwei8a2o)
+   IF (l_wei_i8) CLOSE (unit = nwei4a2o)
+   !
+   STOP
+   !!
+CONTAINS
+   !!
+   SUBROUTINE gather_wei
+      WRITE(nout,*) 'Gather weight : Periodicity'
+      DO jn = 1, jpa2o
+         CALL lbc (wa2o(jn,:) , noperio, 'T', jpoi, jpoj)
+         CALL lbc (ka2o(jn,:) , noperio, 'T', jpoi, jpoj)
+      END DO
+      !!
+      WRITE(nout,*) 'Gather weights : gather'
+      DO jo = 1, jpon
+         ktemp = ka2o(:,jo) ; wtemp = wa2o(:,jo)
+         ka2o(:,jo) = 0_il  ; wa2o(:,jo) = 0.0_rl
+         kn = 1_il
+         DO jn = 1, jma2o
+            IF (ktemp(jn) /= 0_il ) THEN
+               ka2o(kn,jo) =  ktemp(jn)
+               wa2o(kn,jo) =  wtemp(jn)
+               kn = kn + 1_il
+            END IF
+         END DO
+      END DO
+      WRITE(nout,*) 'Gather weights : stat'
+      nvo = COUNT (ka2o /= 0_il, DIM = 1)
+      jma2o = MAXVAL (nvo)
+      !!
+   END SUBROUTINE gather_wei
+   !!
+END PROGRAM isf_icb
+
Index: /TOOLS/MOZAIC/src/MOZAIC/lbc.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lbc.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lbc.f90	(revision 3326)
@@ -0,0 +1,282 @@
+! -*- Mode: f90 -*-
+MODULE mod_lbc
+   USE declare
+   !> Periodicite des champs
+   !
+   !> Multiply 2D vectors
+   INTERFACE lbc
+      MODULE PROCEDURE lbc_r1, lbc_i1, lbc_l1, lbc_r2, lbc_i2, lbc_l2, lbc_r3
+   END INTERFACE lbc
+CONTAINS
+   !
+   !> Periodicity of real fields
+   SUBROUTINE lbc_r1 (ptab, npolj, cd_type, ni, nj, sgn)
+      IMPLICIT NONE
+      !
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: ni !< Array dimension
+      INTEGER (kind=il), INTENT (in) :: nj !< Array dimension
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      REAL (kind=rl), DIMENSION (ni * nj), INTENT (inout) :: ptab !< Input array
+      REAL (kind=rl), INTENT (in), OPTIONAL :: sgn
+      REAL (kind=rl), DIMENSION (ni, nj) :: ptab2d !< Temp array
+      INTEGER :: ji, jl, ijt, iju, ijpj
+      !
+      ptab2d (:,:) = RESHAPE (ptab, (/ ni, nj /) )
+      !
+      IF ( PRESENT (sgn)) THEN
+         CALL lbc_r2 ( ptab2d (:,:), npolj, cd_type, sgn)
+      ELSE
+         CALL lbc_r2 ( ptab2d (:,:), npolj, cd_type)
+      ENDIF
+      !
+      ptab (:) = RESHAPE ( ptab2d, (/ ni*nj /) )
+
+   END SUBROUTINE lbc_r1
+   !
+   SUBROUTINE lbc_r3 (ptab3d, npolj, cd_type, sgn)
+      !> Periodicity of real fields
+      IMPLICIT NONE
+      !
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      REAL (kind=rl), DIMENSION (:, :, :), INTENT (inout) :: ptab3d !< Input array
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      REAL (kind=rl), INTENT (in), OPTIONAL :: sgn
+      INTEGER :: jk
+
+      DO jk = 1, SIZE ( ptab3d, DIM=3) 
+         IF ( PRESENT (sgn)) THEN
+            CALL lbc_r2 ( ptab3d (:,:, jk), npolj, cd_type, sgn)
+         ELSE
+            CALL lbc_r2 ( ptab3d (:,:, jk), npolj, cd_type)
+         ENDIF
+      END DO
+
+   END SUBROUTINE lbc_r3
+
+   SUBROUTINE lbc_i2 (pt2d, npolj, cd_type, sgn) 
+      !> Periodicity on integer fields
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      INTEGER (kind=il), DIMENSION (:, :), INTENT (inout) :: pt2d !< Input array
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      REAL (kind=rl), DIMENSION (SIZE(pt2d,DIM=1),SIZE(pt2d,DIM=2)) :: ztab2d !< Temp array 
+      INTEGER (kind=il), INTENT (in), OPTIONAL :: sgn
+      !
+      ztab2d (:,:) = REAL ( pt2d(:,:), KIND=rl)
+      !
+      IF ( PRESENT (sgn)) THEN 
+         CALL lbc_r2 ( ztab2d (:,:), npolj, cd_type, REAL(sgn,KIND=rl))
+      ELSE
+         CALL lbc_r2 ( ztab2d (:,:), npolj, cd_type)
+      ENDIF
+      !
+      pt2d (:,:) = NINT ( ztab2d (:,:))
+      !
+
+      RETURN
+   END SUBROUTINE lbc_i2
+   !
+   SUBROUTINE lbc_i1 (ptab, npolj, cd_type, ni, nj, sgn)
+      IMPLICIT NONE
+      !
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: ni !< Array dimension
+      INTEGER (kind=il), INTENT (in) :: nj !< Array dimension
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      INTEGER (kind=il), DIMENSION (ni * nj), INTENT (inout) :: ptab !< Input array
+      INTEGER (kind=il), INTENT (in), OPTIONAL :: sgn
+      REAL (kind=rl), DIMENSION (ni, nj) :: ptab2d !< Temp array
+      INTEGER :: ji, jl, ijt, iju, ijpj, ipr2dj
+
+      ptab2d (:,:) = RESHAPE (REAL(ptab,KIND=rl), (/ ni, nj /) )
+
+      IF ( PRESENT (sgn)) THEN
+         CALL lbc_r2 ( ptab2d (:,:), npolj, cd_type, REAL(sgn,KIND=rl))
+      ELSE
+         CALL lbc_r2 ( ptab2d (:,:), npolj, cd_type)
+      END IF
+      ptab (:) = RESHAPE ( NINT(ptab2d), (/ ni*nj /) )
+
+   END SUBROUTINE lbc_i1
+
+   SUBROUTINE lbc_l1 (ptab, npolj, cd_type, ni, nj)
+      IMPLICIT NONE
+      !
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      INTEGER (kind=il) :: ni !< Array dimension
+      INTEGER (kind=il) :: nj !< Array dimension
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      LOGICAL, DIMENSION (ni * nj), INTENT (inout) :: ptab !< Input array
+      LOGICAL, DIMENSION (ni, nj) :: ptab2d !< Temp array
+      INTEGER :: ji, jl, ijt, iju, ijpj, ipr2dj
+
+      ptab2d (:,:) = RESHAPE (ptab, (/ ni, nj /) )
+
+      CALL lbc_l2 ( ptab2d (:,:), npolj, cd_type)
+
+      ptab (:) = RESHAPE ( ptab2d, (/ ni*nj /) )
+
+   END SUBROUTINE lbc_l1
+
+   SUBROUTINE lbc_l2 (pt2d, npolj, cd_type) 
+      !> Periodicity on integer fields
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      LOGICAL, DIMENSION (:, :), INTENT (inout) :: pt2d !< Input array
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      REAL (kind=rl), DIMENSION (SIZE(pt2d,DIM=1),SIZE(pt2d,DIM=2)) :: ztab2d !< Temp array 
+      !
+      ztab2d (:,:) = 0.0_rl
+      WHERE ( pt2d (:,:)) ztab2d (:,:) = 1.0_rl
+!-$$      ztab2d (:,:)  MERGE( 1.0_rl, 0.0_rl, pt2d (:,:) )
+      !
+      CALL lbc_r2 ( ztab2d (:,:), npolj, cd_type)
+      !
+      pt2d (:,:) = ztab2d (:,:) .GT. 0.5_rl
+      !
+
+      RETURN
+   END SUBROUTINE lbc_l2
+
+   SUBROUTINE lbc_r2 (pt2d, npolj, cd_type, sgn)
+      !> Periodicity of real fields
+      IMPLICIT NONE
+      !
+      INTEGER (kind=il), INTENT (in) :: npolj !< Type of periodicity
+      REAL (kind=rl), DIMENSION (:, :), INTENT (inout) :: pt2d !< Input array
+      CHARACTER (len=*), INTENT (in) :: cd_type !< Grid specification : T, U, V or F
+      REAL (kind=rl), INTENT (in), OPTIONAL :: sgn
+      !
+      REAL (kind=rl) :: psgn
+      INTEGER (kind=il) :: jpiglo !< Array dimension
+      INTEGER (kind=il) :: jpjglo !< Array dimension
+      INTEGER :: ji, jl, ijt, iju, ijpj, ijpjm1
+      !
+      IF ( PRESENT (sgn)) THEN 
+         psgn = sgn
+      ELSE
+         psgn = 1.0_rl
+      ENDIF
+      !
+      !
+      jpiglo = SIZE ( pt2d, DIM=1)
+      jpjglo = SIZE ( pt2d, DIM=2)
+      !
+      ijpj   = jpjglo           ! 1 proc only  along the i-direction
+      ijpjm1 = ijpj-1
+
+      IF (npolj == 0_il) RETURN
+      !
+      !> @par East-West boundary conditions
+      ! --------------------------------
+
+      !
+      SELECT CASE (npolj)
+      CASE ( 1, 4, 6 )
+         ! ... cyclic
+         pt2d ( 1    , :) = pt2d (jpiglo-1, :)
+         pt2d (jpiglo, :) = pt2d ( 2      , :)
+      END SELECT
+      !
+      !> @par North-South boundary conditions
+      ! ----------------------------------
+      !
+      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
+               pt2d(ji,ijpj) = psgn * pt2d(ijt,ijpj-2)
+            END DO
+            pt2d(1,ijpj) = psgn * pt2d(3,ijpj-2)
+            DO ji = jpiglo/2+1, jpiglo
+               ijt = jpiglo-ji+2
+               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
+            END DO
+         CASE ( 'U' )          ! U-point
+            DO ji = 1, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpj) = psgn * pt2d(iju,ijpj-2)
+            END DO
+            pt2d(   1  ,ijpj) = psgn * pt2d(    2   ,ijpj-2)
+            pt2d(jpiglo,ijpj) = psgn * pt2d(jpiglo-1,ijpj-2) 
+            DO ji = jpiglo/2, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         CASE ( 'V' )          ! V-point
+            DO ji = 2, jpiglo
+               ijt = jpiglo-ji+2
+               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-2)
+               pt2d(ji,ijpj  ) = psgn * pt2d(ijt,ijpj-3)
+            END DO
+            pt2d(1,ijpj) = psgn * pt2d(3,ijpj-3) 
+         CASE ( 'F' )          ! F-point
+            DO ji = 1, jpiglo-1
+               iju = jpiglo-ji+1
+               pt2d(ji,ijpj-1) = psgn * pt2d(iju,ijpj-2)
+               pt2d(ji,ijpj  ) = psgn * pt2d(iju,ijpj-3)
+            END DO
+            pt2d(   1  ,ijpj) = psgn * pt2d(    2   ,ijpj-3)
+            pt2d(jpiglo,ijpj) = psgn * pt2d(jpiglo-1,ijpj-3) 
+         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
+               pt2d(ji,ijpj) = psgn * pt2d(ijt,ijpj-1)
+            END DO
+         CASE ( 'U' )          ! U-point
+            DO ji = 1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpj) = psgn * pt2d(iju,ijpj-1)
+            END DO
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
+         CASE ( 'V' )          ! V-point
+            DO ji = 1, jpiglo
+               ijt = jpiglo-ji+1
+               pt2d(ji,ijpj) = psgn * pt2d(ijt,ijpj-2)
+            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 ji = 1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpj  ) = psgn * pt2d(iju,ijpj-2)
+            END DO
+            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
+            DO ji = jpiglo/2+1, jpiglo-1
+               iju = jpiglo-ji
+               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
+            END DO
+         END SELECT
+         !
+      CASE ( -1 )
+         !
+         !> @par LMDz type boundary conditions
+         ! 
+         SELECT CASE ( cd_type)
+         CASE ( 'T' )
+            DO ji = 2, jpiglo
+               pt2d (ji,   1   ) = pt2d (1, 1    )
+               pt2d (ji, jpjglo) = pt2d (1,jpjglo)
+            END DO
+         END SELECT
+ 
+         !
+      END SELECT                !  npolj
+      !
+   END SUBROUTINE lbc_r2
+   !
+END MODULE mod_lbc
Index: /TOOLS/MOZAIC/src/MOZAIC/lbc1.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lbc1.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lbc1.f90	(revision 3326)
@@ -0,0 +1,239 @@
+! -*- Mode: f90 -*-
+MODULE mod_lbc_1
+   !> Periodicite des champs
+   !
+   !> Multiply 2D vectors
+   INTERFACE lbc
+      MODULE PROCEDURE lbc_r, lbc_i, lbc_l
+   END INTERFACE lbc
+CONTAINS
+   !
+   !> Periodicity of real fields
+   SUBROUTINE lbc_r (ptab, kperio, cd_type, ki, kj )
+      !> Periodicity of real fields
+      USE declare
+      IMPLICIT NONE
+      !
+      INTEGER (kind=il), INTENT (in) :: kperio !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: ki !< Array dimension
+      INTEGER (kind=il), INTENT (in) :: kj !< Array dimension
+      CHARACTER (len=1) :: cd_type !< Grid specification : T, U, V or F
+      REAL (kind=rl), DIMENSION (ki * kj), INTENT (inout) :: ptab !< Input array
+      REAL (kind=rl), DIMENSION (ki, kj) :: ztab !< Temp array
+      !
+      IF (kperio == 0_il) RETURN
+      !
+      ztab = RESHAPE (ptab, (/ ki, kj /) )
+      !
+      !> @par East-West boundary conditions
+      ! --------------------------------
+      !
+      IF (kperio == 1_il .OR. kperio == 4_il ) THEN 
+         ! ... cyclic
+         ztab (1, :) = ztab (ki-1, :)
+         ztab (ki, :) = ztab ( 2  , :)
+      ENDIF
+      !
+      !> @par North-South boundary conditions
+      ! ----------------------------------
+      !
+      IF (kperio == 3 .OR. kperio == 4) THEN 
+         ! ... north fold
+         !
+         SELECT CASE (cd_type) 
+         CASE ('T' ) 
+            ztab (2     :ki  , kj  ) = ztab (ki    :2:-1, kj-2)
+            ztab (ki/2+1:ki  , kj-1) = ztab (ki/2+1:2:-1, kj-1)
+         CASE ('U' )
+            ztab (1     :ki-1, kj  ) = ztab (ki    :2:-1, kj-2)
+            ztab (ki/2  :ki-1, kj-1) = ztab (ki/2+1:2:-1, kj-1)
+         CASE ('V' )
+            ztab (2     :ki  , kj-1) = ztab (ki    :2:-1, kj-2)
+            ztab (2     :ki  , kj  ) = ztab (ki    :2:-1, kj-3)
+         CASE ('F' )
+            ztab (1     :ki-1, kj  ) = ztab (ki    :2:-1, kj-3)
+            ztab (1     :ki-1, kj-1) = ztab (ki    :2:-1, kj-2)
+         END SELECT
+         !
+      ENDIF
+      !
+      IF (kperio == -4) THEN 
+         ! ... north fold
+         !
+         SELECT CASE (cd_type) 
+         CASE ('T' ) 
+            ztab (ki/2+1:ki  , kj) = ztab (ki/2+1:2:-1, kj)
+         CASE ('U' )
+            ztab (ki/2  :ki-1, kj) = ztab (ki/2+1:2:-1, kj)
+         CASE ('V' )
+            ztab (2     :ki  , kj) = ztab (ki    :2:-1, kj-1)
+         CASE ('F' )
+            ztab (1     :ki-1, kj) = ztab (ki    :2:-1, kj-1)
+         END SELECT
+         !
+      ENDIF
+      !
+      !> @par LMDz type boundary conditions
+      !
+      IF (kperio == -1_il ) THEN 
+         ztab (2:ki, 1 ) = ztab (1,1)
+         ztab (2:ki, kj) = ztab (1,kj)
+      ENDIF
+      !
+      ptab = RESHAPE (ztab, (/ ki * kj /) )
+      !
+   END SUBROUTINE lbc_r
+   !
+   !!---------------------------------------------------------------------
+   SUBROUTINE lbc_i (ktab, kperio, cd_type, ki, kj) 
+      !> Periodicity on integer fields
+      USE declare
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il), INTENT (in) :: kperio !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: ki !< Input array dimensions
+      INTEGER (kind=il), INTENT (in) :: kj !< Input array dimensions
+      CHARACTER (len=1) :: cd_type !< Grid specification : T, U, V or F
+      INTEGER (kind=il), DIMENSION (ki * kj), INTENT (inout) :: ktab !< Input array
+      INTEGER (kind=il), DIMENSION (ki, kj) :: itab !< Temp array
+      !
+      IF (kperio == 0_il) RETURN
+      !
+      itab = RESHAPE (ktab, (/ ki, kj/) )
+      !
+      ! 1. East-West boundary conditions
+      ! --------------------------------
+      !
+      IF (kperio == 1 .OR. kperio == 4 ) THEN
+         ! ... cyclic
+         itab (1, :) = itab (ki-1, :)
+         itab (ki, :) = itab (  2 , :)
+      END IF
+      !
+      ! 2. North-South boundary conditions
+      ! ----------------------------------
+      !
+      IF (kperio == 3_il .OR. kperio == 4_il) THEN 
+         ! ... north fold
+         !
+         SELECT CASE (cd_type) 
+         CASE ('T')
+            itab (2     :ki  , kj  ) = itab (ki    :2:-1, kj-2)
+            itab (ki/2+1:ki  , kj-1) = itab (ki/2+1:2:-1, kj-1)
+         CASE ('U' )
+            itab (1     :ki-1, kj  ) = itab (ki    :2:-1, kj-2)
+            itab (ki/2  :ki-1, kj-1) = itab (ki/2+1:2:-1, kj-1)
+         CASE ('V' )
+            itab (2     :ki  , kj-1) = itab (ki    :2:-1, kj-2)
+            itab (2     :ki  , kj  ) = itab (ki    :2:-1, kj-3)
+         CASE ('F' )
+            itab (1     :ki-1, kj-1) = itab (ki    :2:-1, kj-2)
+            itab (1     :ki-1, kj  ) = itab (ki    :2:-1, kj-3)
+         END SELECT
+         !
+      ENDIF
+      !
+      IF (kperio == -4_il) THEN 
+         ! ... north fold
+         !
+         SELECT CASE (cd_type) 
+         CASE ('T' ) 
+            itab (ki/2+1:ki  , kj) = itab (ki/2+1:2:-1, kj)
+         CASE ('U' )
+            itab (ki/2  :ki-1, kj) = itab (ki/2+1:2:-1, kj)
+         CASE ('V' )
+            itab (2     :ki  , kj) = itab (ki    :2:-1, kj-1)
+         CASE ('F' )
+            itab (1     :ki-1, kj) = itab (ki    :2:-1, kj-1)
+         END SELECT
+         !
+      ENDIF
+      !
+      ! 3. LMDz type boundary conditions
+      !
+      IF (kperio == -1_il ) THEN 
+         itab (2:ki, 1 ) = itab (1,1)
+         itab (2:ki, kj) = itab (1,kj)
+      ENDIF
+      !
+      ktab = RESHAPE (itab, (/ ki * kj /) )
+      !
+   END SUBROUTINE lbc_i
+   !!
+   !!---------------------------------------------------------------------
+   !> Periodicity of logical fields
+   SUBROUTINE lbc_l (ltab, kperio, cd_type, ki, kj ) 
+      !> Periodicity of logical fields
+      USE declare
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il), INTENT (in) :: kperio !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: ki !< Input array dimensions
+      INTEGER (kind=il), INTENT (in) :: kj !< Input array dimensions
+      CHARACTER (len=1) :: cd_type !< Grid specification : T, U, V or F
+      LOGICAL, DIMENSION (ki * kj), INTENT (inout) :: ltab !< Input array
+      LOGICAL, DIMENSION (ki, kj) :: itab !< Temp array
+      !
+      IF (kperio == 0_il) RETURN
+      !
+      itab = RESHAPE (ltab, (/ ki, kj/) )
+      !
+      ! 1. East-West boundary conditions
+      ! --------------------------------
+      !
+      IF (kperio == 1_il .OR. kperio == 4_il ) THEN
+         ! ... cyclic
+         itab (1, :) = itab (ki-1, :)
+         itab (ki, :) = itab (  2 , :)
+      END IF
+      !
+      ! 2. North-South boundary conditions
+      ! ----------------------------------
+      !
+      IF (kperio == 3_il .OR. kperio == 4_il ) THEN 
+         ! ... north fold
+         !
+         SELECT CASE (cd_type)
+         CASE ('T' )
+            itab (2     :ki  , kj  ) = itab (ki    :2:-1, kj-2)
+            itab (ki/2+1:ki  , kj-1) = itab (ki/2+1:2:-1, kj-1)
+         CASE ('U' )
+            itab (1     :ki-1, kj  ) = itab (ki    :2:-1, kj-2)
+            itab (ki/2  :ki-1, kj-1) = itab (ki/2+1:2:-1, kj-1)
+         CASE ('V' )
+            itab (2     :ki  , kj-1) = itab (ki    :2:-1, kj-2)
+            itab (2     :ki  , kj  ) = itab (ki    :2:-1, kj-3)
+         CASE('F')
+            itab (1     :ki-1, kj-1) = itab (ki    :2:-1, kj-2)
+            itab (1     :ki-1, kj  ) = itab (ki    :2:-1, kj-3)
+         END SELECT
+         !
+      ENDIF
+      !
+      IF (kperio == -4_il) THEN 
+         ! ... north fold
+         !
+         SELECT CASE (cd_type) 
+         CASE ('T' ) 
+            itab (ki/2+1:ki  , kj) = itab (ki/2+1:2:-1, kj)
+         CASE ('U' )
+            itab (ki/2  :ki-1, kj) = itab (ki/2+1:2:-1, kj)
+         CASE ('V' )
+            itab (2     :ki  , kj) = itab (ki    :2:-1, kj-1)
+         CASE ('F' )
+            itab (1     :ki-1, kj) = itab (ki    :2:-1, kj-1)
+         END SELECT
+         !
+      ENDIF
+      !
+      ! 3. LMDz type boundary conditions
+      !
+      IF (kperio == -1_il) THEN 
+         itab (2:ki, 1 ) = itab (1,1 )
+         itab (2:ki, kj) = itab (1,kj)
+      ENDIF
+      !
+      ltab = RESHAPE (itab, (/ ki * kj /) )
+      !
+   END SUBROUTINE lbc_l
+END MODULE mod_lbc_1
Index: /TOOLS/MOZAIC/src/MOZAIC/lbc2.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lbc2.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lbc2.f90	(revision 3326)
@@ -0,0 +1,201 @@
+! -*- Mode: f90 -*-
+!_ ------------------------------------------------------------------
+!_ $RCSfile: lbc.f,v $ ($Source: /home/ioipsl/CVSROOT/UTIL/MOZAIC/mozaic/lbc.f,v $ )
+!_ $Name:  $   ; $Revision: 1.2 $
+!_ $Date: 2002/09/06 14:24:52 $   ; $State: Exp $
+!_ $Author: adm $ ; $Locker:  $
+!_ ------------------------------------------------------------------
+MODULE mod_lbc_2
+   USE declare
+   IMPLICIT NONE
+   !! Periodicite des champs
+   INTERFACE lbc
+      MODULE PROCEDURE lbc_r, lbc_i, lbc_l
+   END INTERFACE
+CONTAINS
+   !!
+   SUBROUTINE lbc_r (ptab, kperio, cd_type, kni, knj) 
+      INTEGER (kind=il), INTENT (in) :: kperio, kni, knj
+      REAL (kind=rl), DIMENSION (kni * knj), INTENT (inout) :: ptab
+      REAL (kind=rl), DIMENSION (kni, knj) :: ztab
+      CHARACTER(len=1), INTENT( in ) ::   cd_type
+      INTEGER (kind=il) ::   ji, ijt, iju
+      !!----------------------------------------------------------------------
+      IF (kperio == 0_il) RETURN
+      ztab = RESHAPE (ptab, (/ kni, knj /) )
+      !                                       
+      SELECT CASE ( kperio )                   ! East-West boundaries
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         ztab( 1 ,:) = ztab(kni-1,:)
+         ztab(kni,:) = ztab(  2  ,:)
+      END SELECT
+      !                                        ! ======================
+      SELECT CASE ( kperio )                   ! North-South boundaries
+
+      CASE ( 2 )                               ! * South symmetric
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                
+            ztab(:, 1 ) = ztab(:,3)
+         CASE ( 'V' , 'F' , 'I' )               
+            ztab(:, 1 ) = ztab(:,2)
+         END SELECT
+      CASE ( 3 , 4 )                            ! * North fold  T-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            ztab (2      :kni  , knj  ) = ztab (kni    :2:-1, knj-2)
+            ztab (kni/2+1:kni  , knj-1) = ztab (kni/2+1:2:-1, knj-1)                           ! T-, W-point
+         CASE ( 'U' ) 
+            ztab (1      :kni-1, knj  ) = ztab (kni    :2:-1, knj-2)
+            ztab (kni/2  :kni-1, knj-1) = ztab (kni/2+1:2:-1, knj-1)
+         CASE ( 'V' )
+            ztab (2      :kni  , knj-1) = ztab (kni    :2:-1, knj-2)
+            ztab (2      :kni  , knj  ) = ztab (kni    :2:-1, knj-3)
+         CASE ( 'F' )
+            ztab (1      :kni-1, knj  ) = ztab (kni    :2:-1, knj-3)
+            ztab (1      :kni-1, knj-1) = ztab (kni    :2:-1, knj-2)
+         END SELECT
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            ztab (1       :kni , knj  ) = ztab (kni        :1:-1, knj-1)
+         CASE ( 'U' )                                  ! U-point
+            ztab (1      :kni-1, knj  ) = ztab (kni-1      :1:-1, knj-1)
+         CASE ( 'V' ) 
+            ztab (1      :kni  , knj  ) = ztab (kni        :1:-1, knj-2)
+            ztab (kni/2+1:kni  , knj-1) = ztab (kni-kni/2  :1:-1, knj-1)
+         CASE ( 'F' ) 
+            ztab (1      :kni-1, knj  ) = ztab (kni-1      :1:-1, knj-2)
+            ztab (kni/2+1:kni-1, knj-1) = ztab (kni-kni/2-1:1:-1, knj-1)
+         END SELECT
+      CASE ( -1) ! LMDz type boundary conditions
+         ztab (2:kni, 1  ) = ztab (1, 1  )
+         ztab (2:kni, knj) = ztab (1, knj)
+      END SELECT
+      !
+      ptab = RESHAPE (ztab, (/ kni * knj /) )
+   END SUBROUTINE lbc_r
+   !
+   SUBROUTINE lbc_i (ktab, kperio, cd_type, kni, knj) 
+      INTEGER (kind=il), INTENT (in) :: kperio, kni, knj
+      INTEGER (kind=il), DIMENSION (kni * knj), INTENT (inout) :: ktab
+      INTEGER (kind=il), DIMENSION (kni, knj) :: itab
+      CHARACTER(len=1), INTENT( in ) ::   cd_type
+      INTEGER (kind=il) ::   ji, ijt, iju
+      !!----------------------------------------------------------------------
+      IF (kperio == 0_il) RETURN
+      itab = RESHAPE (ktab, (/ kni, knj /) )
+      !                                       
+      SELECT CASE ( kperio )                   ! East-West boundaries
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         itab( 1 ,:) = itab(kni-1,:)
+         itab(kni,:) = itab(  2  ,:)
+      END SELECT
+      !                                        ! ======================
+      SELECT CASE ( kperio )                   ! North-South boundaries
+
+      CASE ( 2 )                               ! * South symmetric
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                
+            itab(:, 1 ) = itab(:,3)
+         CASE ( 'V' , 'F' , 'I' )               
+            itab(:, 1 ) = itab(:,2)
+         END SELECT
+      CASE ( 3 , 4 )                            ! * North fold  T-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni/2+1:2:-1, knj-1)                           ! T-, W-point
+         CASE ( 'U' ) 
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2  :kni-1, knj-1) = itab (kni/2+1:2:-1, knj-1)
+         CASE ( 'V' )
+            itab (2      :kni  , knj-1) = itab (kni    :2:-1, knj-2)
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-3)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-3)
+            itab (1      :kni-1, knj-1) = itab (kni    :2:-1, knj-2)
+         END SELECT
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (1       :kni , knj  ) = itab (kni        :1:-1, knj-1)
+         CASE ( 'U' ) 
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-1)
+         CASE ( 'V' )                                  ! V-point
+            itab (1      :kni  , knj  ) = itab (kni        :1:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni-kni/2  :1:-1, knj-1)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-2)
+            itab (kni/2+1:kni-1, knj-1) = itab (kni-kni/2-1:1:-1, knj-1)
+         END SELECT
+      CASE ( -1) ! LMDz type boundary conditions
+         itab (2:kni, 1  ) = itab (1, 1  )
+         itab (2:kni, knj) = itab (1, knj)
+      END SELECT
+      !
+      ktab = RESHAPE (itab, (/ kni * knj /) )
+   END SUBROUTINE lbc_i
+   !
+   SUBROUTINE lbc_l (ltab, kperio, cd_type, kni, knj) 
+      INTEGER (kind=il), INTENT (in) :: kperio, kni, knj
+      LOGICAL, DIMENSION (kni * knj), INTENT (inout) :: ltab
+      LOGICAL, DIMENSION (kni, knj) :: itab
+      CHARACTER(len=1), INTENT( in ) ::   cd_type
+      INTEGER (kind=il) ::   ji, ijt, iju
+      !!----------------------------------------------------------------------
+      IF (kperio == 0_il) RETURN
+      itab = RESHAPE (ltab, (/ kni, knj /) )
+      !                                       
+      SELECT CASE ( kperio )                   ! East-West boundaries
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         itab( 1 ,:) = itab(kni-1,:)
+         itab(kni,:) = itab(  2  ,:)
+      END SELECT
+      !                                        ! ======================
+      SELECT CASE ( kperio )                   ! North-South boundaries
+
+      CASE ( 2 )                               ! * South symmetric
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                
+            itab(:, 1 ) = itab(:,3)
+         CASE ( 'V' , 'F' , 'I' )               
+            itab(:, 1 ) = itab(:,2)
+         END SELECT
+      CASE ( 3 , 4 )                            ! * North fold  T-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni/2+1:2:-1, knj-1) 
+         CASE ( 'U' )
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2  :kni-1, knj-1) = itab (kni/2+1:2:-1, knj-1)
+         CASE ( 'V' )
+            itab (2      :kni  , knj-1) = itab (kni    :2:-1, knj-2)
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-3)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-3)
+            itab (1      :kni-1, knj-1) = itab (kni    :2:-1, knj-2)
+         END SELECT
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (1       :kni , knj  ) = itab (kni        :1:-1, knj-1)
+         CASE ( 'U' ) 
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-1)
+         CASE ( 'V' )
+            itab (1      :kni  , knj  ) = itab (kni        :1:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni-kni/2  :1:-1, knj-1)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-2)
+            itab (kni/2+1:kni-1, knj-1) = itab (kni-kni/2-1:1:-1, knj-1)
+         END SELECT
+      CASE ( -1) ! LMDz type boundary conditions
+         itab (2:kni, 1  ) = itab (1, 1  )
+         itab (2:kni, knj) = itab (1, knj)
+      END SELECT
+      !
+      ltab = RESHAPE (itab, (/ kni * knj /) )
+   END SUBROUTINE lbc_l
+   !!
+END MODULE mod_lbc_2
+
Index: /TOOLS/MOZAIC/src/MOZAIC/lbc2.f90_unused
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lbc2.f90_unused	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lbc2.f90_unused	(revision 3326)
@@ -0,0 +1,201 @@
+! -*- Mode: f90 -*-
+MODULE mod_lbc_unused
+   USE declare
+   IMPLICIT NONE
+   !> Periodicite des champs
+   INTERFACE lbc_unused
+      MODULE PROCEDURE lbc_r, lbc_i, lbc_l
+   END INTERFACE
+CONTAINS
+   !!
+   SUBROUTINE lbc_r (ptab, kperio, cd_type, kni, knj) 
+      !< Periodicity of real fields
+      INTEGER (kind=il), INTENT (in) :: kperio  !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: kni, knj  !< Array dimension
+      REAL (kind=rl), DIMENSION (kni * knj), INTENT (inout) :: ptab !< Input array
+      REAL (kind=rl), DIMENSION (kni, knj) :: ztab !< Temp array
+      CHARACTER(len=1), INTENT( in ) ::   cd_type !< Grid specification : T, U, V or F
+      INTEGER (kind=il) ::   ji, ijt, iju
+      !!----------------------------------------------------------------------
+      IF (kperio == 0_il) RETURN
+      ztab = RESHAPE (ptab, (/ kni, knj /) )
+      !                                       
+      SELECT CASE ( kperio )                   ! East-West boundaries
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         ztab( 1 ,:) = ztab(kni-1,:)
+         ztab(kni,:) = ztab(  2  ,:)
+      END SELECT
+      !                                        ! ======================
+      SELECT CASE ( kperio )                   ! North-South boundaries
+
+      CASE ( 2 )                               ! * South symmetric
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                
+            ztab(:, 1 ) = ztab(:,3)
+         CASE ( 'V' , 'F' , 'I' )               
+            ztab(:, 1 ) = ztab(:,2)
+         END SELECT
+      CASE ( 3 , 4 )                            ! * North fold  T-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            ztab (2      :kni  , knj  ) = ztab (kni    :2:-1, knj-2)
+            ztab (kni/2+1:kni  , knj-1) = ztab (kni/2+1:2:-1, knj-1)                           ! T-, W-point
+         CASE ( 'U' ) 
+            ztab (1      :kni-1, knj  ) = ztab (kni    :2:-1, knj-2)
+            ztab (kni/2  :kni-1, knj-1) = ztab (kni/2+1:2:-1, knj-1)
+         CASE ( 'V' )
+            ztab (2      :kni  , knj-1) = ztab (kni    :2:-1, knj-2)
+            ztab (2      :kni  , knj  ) = ztab (kni    :2:-1, knj-3)
+         CASE ( 'F' )
+            ztab (1      :kni-1, knj  ) = ztab (kni    :2:-1, knj-3)
+            ztab (1      :kni-1, knj-1) = ztab (kni    :2:-1, knj-2)
+         END SELECT
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            ztab (1       :kni , knj  ) = ztab (kni        :1:-1, knj-1)
+         CASE ( 'U' )                                  ! U-point
+            ztab (1      :kni-1, knj  ) = ztab (kni-1      :1:-1, knj-1)
+         CASE ( 'V' ) 
+            ztab (1      :kni  , knj  ) = ztab (kni        :1:-1, knj-2)
+            ztab (kni/2+1:kni  , knj-1) = ztab (kni-kni/2  :1:-1, knj-1)
+         CASE ( 'F' ) 
+            ztab (1      :kni-1, knj  ) = ztab (kni-1      :1:-1, knj-2)
+            ztab (kni/2+1:kni-1, knj-1) = ztab (kni-kni/2-1:1:-1, knj-1)
+         END SELECT
+      CASE ( -1) ! LMDz type boundary conditions
+         ztab (2:kni, 1  ) = ztab (1, 1  )
+         ztab (2:kni, knj) = ztab (1, knj)
+      END SELECT
+      !
+      ptab = RESHAPE (ztab, (/ kni * knj /) )
+   END SUBROUTINE lbc_r
+   !
+   SUBROUTINE lbc_i (ktab, kperio, cd_type, kni, knj) 
+      !> Periodicity of integer fields
+      INTEGER (kind=il), INTENT (in) :: kperio  !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: kni, knj !< Input array dimensions
+      INTEGER (kind=il), DIMENSION (kni * knj), INTENT (inout) :: ktab !< Input array
+      INTEGER (kind=il), DIMENSION (kni, knj) :: itab  !< Temp array
+      CHARACTER(len=1), INTENT( in ) ::   cd_type !< Grid specification : T, U, V or F
+      INTEGER (kind=il) ::   ji, ijt, iju
+      !!----------------------------------------------------------------------
+      IF (kperio == 0_il) RETURN
+      itab = RESHAPE (ktab, (/ kni, knj /) )
+      !                                       
+      SELECT CASE ( kperio )                   ! East-West boundaries
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         itab( 1 ,:) = itab(kni-1,:)
+         itab(kni,:) = itab(  2  ,:)
+      END SELECT
+      !                                        ! ======================
+      SELECT CASE ( kperio )                   ! North-South boundaries
+
+      CASE ( 2 )                               ! * South symmetric
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                
+            itab(:, 1 ) = itab(:,3)
+         CASE ( 'V' , 'F' , 'I' )               
+            itab(:, 1 ) = itab(:,2)
+         END SELECT
+      CASE ( 3 , 4 )                            ! * North fold  T-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni/2+1:2:-1, knj-1)                           ! T-, W-point
+         CASE ( 'U' ) 
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2  :kni-1, knj-1) = itab (kni/2+1:2:-1, knj-1)
+         CASE ( 'V' )
+            itab (2      :kni  , knj-1) = itab (kni    :2:-1, knj-2)
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-3)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-3)
+            itab (1      :kni-1, knj-1) = itab (kni    :2:-1, knj-2)
+         END SELECT
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (1       :kni , knj  ) = itab (kni        :1:-1, knj-1)
+         CASE ( 'U' ) 
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-1)
+         CASE ( 'V' )                                  ! V-point
+            itab (1      :kni  , knj  ) = itab (kni        :1:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni-kni/2  :1:-1, knj-1)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-2)
+            itab (kni/2+1:kni-1, knj-1) = itab (kni-kni/2-1:1:-1, knj-1)
+         END SELECT
+      CASE ( -1) ! LMDz type boundary conditions
+         itab (2:kni, 1  ) = itab (1, 1  )
+         itab (2:kni, knj) = itab (1, knj)
+      END SELECT
+      !
+      ktab = RESHAPE (itab, (/ kni * knj /) )
+   END SUBROUTINE lbc_i
+   !
+   SUBROUTINE lbc_l (ltab, kperio, cd_type, kni, knj) 
+      !> Periodicity of logical fields
+      INTEGER (kind=il), INTENT (in) :: kperio !< Type of periodicity
+      INTEGER (kind=il), INTENT (in) :: kni, knj  !< Input array dimensions
+      LOGICAL, DIMENSION (kni * knj), INTENT (inout) :: ltab  !< Input array
+      LOGICAL, DIMENSION (kni, knj) :: itab  !< Temp array
+      CHARACTER(len=1), INTENT( in ) ::   cd_type !< Grid specification : T, U, V or F
+      INTEGER (kind=il) ::   ji, ijt, iju
+      !!----------------------------------------------------------------------
+      IF (kperio == 0_il) RETURN
+      itab = RESHAPE (ltab, (/ kni, knj /) )
+      !                                       
+      SELECT CASE ( kperio )                   ! East-West boundaries
+      CASE ( 1 , 4 , 6 )                       ! * cyclic east-west
+         itab( 1 ,:) = itab(kni-1,:)
+         itab(kni,:) = itab(  2  ,:)
+      END SELECT
+      !                                        ! ======================
+      SELECT CASE ( kperio )                   ! North-South boundaries
+
+      CASE ( 2 )                               ! * South symmetric
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'U' , 'W' )                
+            itab(:, 1 ) = itab(:,3)
+         CASE ( 'V' , 'F' , 'I' )               
+            itab(:, 1 ) = itab(:,2)
+         END SELECT
+      CASE ( 3 , 4 )                            ! * North fold  T-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni/2+1:2:-1, knj-1) 
+         CASE ( 'U' )
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-2)
+            itab (kni/2  :kni-1, knj-1) = itab (kni/2+1:2:-1, knj-1)
+         CASE ( 'V' )
+            itab (2      :kni  , knj-1) = itab (kni    :2:-1, knj-2)
+            itab (2      :kni  , knj  ) = itab (kni    :2:-1, knj-3)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni    :2:-1, knj-3)
+            itab (1      :kni-1, knj-1) = itab (kni    :2:-1, knj-2)
+         END SELECT
+      CASE ( 5 , 6 )                           ! * North fold  F-point pivot
+         SELECT CASE ( cd_type )
+         CASE ( 'T' , 'W' ) 
+            itab (1       :kni , knj  ) = itab (kni        :1:-1, knj-1)
+         CASE ( 'U' ) 
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-1)
+         CASE ( 'V' )
+            itab (1      :kni  , knj  ) = itab (kni        :1:-1, knj-2)
+            itab (kni/2+1:kni  , knj-1) = itab (kni-kni/2  :1:-1, knj-1)
+         CASE ( 'F' )
+            itab (1      :kni-1, knj  ) = itab (kni-1      :1:-1, knj-2)
+            itab (kni/2+1:kni-1, knj-1) = itab (kni-kni/2-1:1:-1, knj-1)
+         END SELECT
+      CASE ( -1) ! LMDz type boundary conditions
+         itab (2:kni, 1  ) = itab (1, 1  )
+         itab (2:kni, knj) = itab (1, knj)
+      END SELECT
+      !
+      ltab = RESHAPE (itab, (/ kni * knj /) )
+   END SUBROUTINE lbc_l
+   !!
+END MODULE mod_lbc_2
+
Index: /TOOLS/MOZAIC/src/MOZAIC/lecdata.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lecdata.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lecdata.f90	(revision 3326)
@@ -0,0 +1,341 @@
+! -*- Mode: f90 -*-
+MODULE mod_lecdata
+CONTAINS
+   SUBROUTINE lecdata (lecweights, leco2amask, cw_num)
+      !>
+      !! Read model characteristics
+      !!
+      !! If dummy argument lecweights is true, read also weights
+      USE declare
+      USE modeles
+      USE mod_locio
+      USE fliocom
+      USE errioipsl
+      USE mod_prih
+      !!
+      IMPLICIT NONE
+      LOGICAL, INTENT (in), OPTIONAL :: lecweights, leco2amask
+      CHARACTER (len=1), INTENT (in), OPTIONAL :: cw_num
+      INTEGER (kind=il) :: kerr = 0
+      REAL    (kind=rl), ALLOCATABLE, DIMENSION (:) :: w_t
+      INTEGER (kind=il), ALLOCATABLE, DIMENSION (:) :: k_t
+      REAL    (kind=rl), ALLOCATABLE, DIMENSION (:, :) :: z2a, z2o, zlon, zlat
+      INTEGER (kind=il), ALLOCATABLE, DIMENSION (:, :) :: i2a, i2o
+      REAL    (kind=rl), ALLOCATABLE, DIMENSION (:, :, :) :: z3a
+      INTEGER (kind=il) :: nb_dim
+      INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ln_dim
+      CHARACTER (len = 80) :: cfname
+      REAL (kind=rl) :: ylat1, ylat2
+      !! NetCDF
+      INTEGER (kind=il) :: il_grid, il_mask, il_area, il_o2a, il_a2o, nco2a
+      CHARACTER (len = 25) :: mo_name, o2a_name, a2o_name
+      CHARACTER (len =  1) :: c_i, c_r
+      CHARACTER (len=1) :: clw_num
+      INTEGER (kind=il) :: ierr
+      INTEGER (kind=il) :: jn
+      !!
+      !!
+      WRITE (UNIT=nout, FMT=*) 'Lecdata-> Parametres appel '
+      WRITE (UNIT=nout, FMT=*) 'lecweights : ', lecweights
+      WRITE (UNIT=nout, FMT=*) 'leco2amask : ', leco2amask
+      IF ( PRESENT (cw_num)) THEN
+         WRITE (UNIT=nout, FMT=*) 'cw_num     : ', cw_num
+      ELSE
+         WRITE (UNIT=nout, FMT=*) 'cw_num     : non present '
+      END IF
+      WRITE (UNIT=nout, FMT=*) 'Lecdata-> Dimensions '
+      WRITE (UNIT=nout, FMT=*) 'Lecdata-> ', 'jpon, jpoi, jpoj, jpoe, noperio, jpan, jpai, jpaj, jpae, naperio'
+      WRITE (UNIT=nout, FMT=*) 'Lecdata-> ', jpon, jpoi, jpoj, jpoe, noperio, jpan, jpai, jpaj, jpae, naperio
+      !!
+      mo_name  = "mozaic"
+      o2a_name = "o2a"
+      a2o_name = "a2o"
+      !
+      IF ( PRESENT(cw_num) ) THEN 
+         clw_num = cw_num
+      ELSE
+         clw_num='2'
+      END IF
+      !!
+      ALLOCATE (z2a (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'z2a')
+      ALLOCATE (z2o (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'z2o')
+      ALLOCATE (i2a (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'i2a')
+      ALLOCATE (i2o (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'i2o')
+      ALLOCATE (z3a (jpai, jpaj,4), STAT=ierr) ; CALL chk_allo (ierr, 'z3a')
+      !!  
+      !! Read coordinates
+      ! CALL ipsldbg (.TRUE.)
+!-$$      IF (l_grid_cdf) THEN
+!-$$         comod = 'orc'
+!-$$      ENDIF
+      !!
+      IF (locerev .OR. l_grid_cdf) THEN
+         comod_t = 't'//TRIM (comod)
+         comod_u = 'u'//TRIM (comod)
+         comod_v = 'v'//TRIM (comod)
+         comod_f = 'f'//TRIM (comod)
+      ELSE
+         comod_t = TRIM (comod) // 't' 
+         comod_u = TRIM (comod) // 'u' 
+         comod_v = TRIM (comod) // 'v' 
+         comod_f = TRIM (comod) // 'f' 
+      ENDIF
+      IF ( catyp(1:8) == 'gaussian' ) THEN
+         camod_t = 'a' // TRIM (camod)
+      ELSE 
+         camod_t = 't' // TRIM (camod)
+         camod_u = 'u' // TRIM (camod)
+         camod_v = 'v' // TRIM (camod)
+         camod_f = 'f' // TRIM (camod) 
+      END IF
+      !!
+      IF (l_grid_cdf) THEN
+         CALL flioopfd ('grids' // TRIM(c_suffix) // '.nc', il_grid)
+         !
+         CALL fliogetv (il_grid, TRIM(comod_t)//'.lon', z2o(:,:)) ; xolont(:) = RESHAPE (z2o(:,:), (/jpon/))
+         CALL fliogetv (il_grid, TRIM(comod_t)//'.lat', z2o(:,:)) ; xolatt(:) = RESHAPE (z2o(:,:), (/jpon/))
+         CALL fliogetv (il_grid, TRIM(camod_t)//'.lon', z2a(:,:)) ; xalont(:) = RESHAPE (z2a(:,:), (/jpan/))
+         CALL fliogetv (il_grid, TRIM(camod_t)//'.lat', z2a(:,:)) ; xalatt(:) = RESHAPE (z2a(:,:), (/jpan/))
+
+         IF ( TRIM(comod) == "orc" .OR. TRIM(comod) == "opa" ) THEN 
+            CALL fliogetv (il_grid, TRIM(comod_u)//'.lon', z2o(:,:)) ; xolonu(:) = RESHAPE (z2o(:,:), (/jpon/))
+            CALL fliogetv (il_grid, TRIM(comod_u)//'.lat', z2o(:,:)) ; xolatu(:) = RESHAPE (z2o(:,:), (/jpon/))
+            CALL fliogetv (il_grid, TRIM(comod_v)//'.lon', z2o(:,:)) ; xolonv(:) = RESHAPE (z2o(:,:), (/jpon/))
+            CALL fliogetv (il_grid, TRIM(comod_v)//'.lat', z2o(:,:)) ; xolatv(:) = RESHAPE (z2o(:,:), (/jpon/))
+            CALL fliogetv (il_grid, TRIM(comod_f)//'.lon', z2o(:,:)) ; xolonf(:) = RESHAPE (z2o(:,:), (/jpon/))
+            CALL fliogetv (il_grid, TRIM(comod_f)//'.lat', z2o(:,:)) ; xolatf(:) = RESHAPE (z2o(:,:), (/jpon/))
+         END IF
+         IF ( TRIM(camod) == "lmd" ) THEN  
+!-$$            CALL fliogetv (il_grid, TRIM(camod_u)//'.lon', z2a(:,:)) ; xalonu(:) = RESHAPE (z2a(:,:), (/jpan/))
+!-$$            CALL fliogetv (il_grid, TRIM(camod_u)//'.lat', z2a(:,:)) ; xalatu(:) = RESHAPE (z2a(:,:), (/jpan/))
+!-$$            CALL fliogetv (il_grid, TRIM(camod_v)//'.lon', z2a(:,:)) ; xalonv(:) = RESHAPE (z2a(:,:), (/jpan/))
+!-$$            CALL fliogetv (il_grid, TRIM(camod_v)//'.lat', z2a(:,:)) ; xalatv(:) = RESHAPE (z2a(:,:), (/jpan/))
+            CALL fliogetv (il_grid, TRIM(camod_t)//'.clo', z3a(:,:,:))
+            xaw (:) = RESHAPE ( MINVAL ( z3a(:,:,:), DIM=3), (/jpan/) )
+            xae (:) = RESHAPE ( MAXVAL ( z3a(:,:,:), DIM=3), (/jpan/) )
+            CALL fliogetv (il_grid, TRIM(camod_t)//'.cla', z3a(:,:,:))
+            yan (:) = RESHAPE ( MAXVAL ( z3a(:,:,:), DIM=3), (/jpan/) )
+            yas (:) = RESHAPE ( MINVAL ( z3a(:,:,:), DIM=3), (/jpan/) )
+
+!-$$            WRITE (nout,*) 'LMD : xaw-xalont ', MINVAL (xaw-xalont), MAXVAL(xaw-xalont)
+!-$$            CALL prihre(RESHAPE(xaw-xalont,(/jpai,jpaj/)),1.0_rl, nout)
+!-$$            WRITE (nout,*) 'LMD : xae-xalont ', MINVAL(xae-xalont), MAXVAL(xae-xalont)
+!-$$            CALL prihre(RESHAPE(xae-xalont,(/jpai,jpaj/)),1.0_rl, nout)
+!-$$            
+!-$$            WRITE (nout,*) 'LMD : yan-xalatt ', MINVAL (yan-xalatt), MAXVAL(yan-xalatt)
+!-$$            CALL prihre(RESHAPE(yan-xalatt,(/jpai,jpaj/)),1.0_rl, nout)
+!-$$            WRITE (nout,*) 'LMD : yas-xalatt ', MINVAL (yas-xalatt), MAXVAL(yas-xalatt)
+!-$$            CALL prihre(RESHAPE(yas-xalatt,(/jpai,jpaj/)),1.0_rl, nout)
+         ENDIF
+         
+         IF ( TRIM(comod) == "grn" .OR. TRIM(comod) == "grs" ) THEN
+            DO jn = 1, 4
+               CALL fliogetv (il_grid, TRIM(comod_t)//'.clo', z2o (:,:), start=(/1,1,jn/), count=(/jpoi,jpoj,1/) )
+               xo_ed (:,jn) = RESHAPE (z2o(:,:), (/jpon/))
+               CALL fliogetv (il_grid, TRIM(comod_t)//'.cla', z2o (:,:), start=(/1,1,jn/), count=(/jpoi,jpoj,1/) )
+               yo_ed (:,jn) = RESHAPE (z2o(:,:), (/jpon/))
+            END DO
+         ENDIF
+
+         IF ( TRIM(camod) == "grn" .OR. TRIM(camod) == "grs" ) THEN
+            DO jn = 1, 4
+               CALL fliogetv (il_grid, TRIM(camod_t)//'.clo', z2a (:,:), start=(/1,1,jn/), count=(/jpai,jpaj,1/) )
+               xa_ed (:,jn) = RESHAPE (z2a(:,:), (/jpan/))
+               CALL fliogetv (il_grid, TRIM(camod_t)//'.cla', z2a (:,:), start=(/1,1,jn/), count=(/jpai,jpaj,1/) )
+               ya_ed (:,jn) = RESHAPE (z2a(:,:), (/jpan/))
+            END DO
+         ENDIF
+
+         CALL flioclo (il_grid)
+
+      ELSE
+         WRITE (unit = cfname, FMT='("grids.r", 1I1)' ) rk_in
+         OPEN (unit = ngrd, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read', status = 'old' )
+         CALL locread (TRIM(comod_t)//'.lon'    , xolont, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 001
+         CALL locread (TRIM(comod_t)//'.lat'    , xolatt, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 002
+         CALL locread (TRIM(comod_u)//'.lon'    , xolonu, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 003
+         CALL locread (TRIM(comod_u)//'.lat'    , xolatu, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 004
+         CALL locread (TRIM(comod_v)//'.lon'    , xolonv, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 001
+         CALL locread (TRIM(comod_v)//'.lat'    , xolatv, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 002
+         CALL locread (TRIM(comod_f)//'.lon'    , xolonf, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 003
+         CALL locread (TRIM(comod_f)//'.lat'    , xolatf, jpon , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 004
+
+         IF ( catyp(1:8) == 'gaussian' ) THEN 
+            CALL locread (TRIM(camod_t)//'.lon', xalont, jpan , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 021
+            CALL locread (TRIM(camod_t)//'.lat', xalatt, jpan , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 022
+         ELSE
+            CALL locread (TRIM(camod_t)//'.lon', xalont, jpan , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 031
+            CALL locread (TRIM(camod_t)//'.lat', xalatt, jpan , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 032
+            CALL locread (TRIM(camod_u)//'.lon', xalonu, jpan , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 033
+            CALL locread (TRIM(camod_u)//'.lat', xalatu, jpan , ngrd, kerr, nout) ; IF (kerr /= 0) STOP 034
+            CALL locread (TRIM(camod_v)//'.lon', xalonv, jpanv, ngrd, kerr, nout) ; IF (kerr /= 0) STOP 035
+            CALL locread (TRIM(camod_v)//'.lat', xalatv, jpanv, ngrd, kerr, nout) ; IF (kerr /= 0) STOP 036
+         END IF
+         !!
+      ENDIF
+      !!
+      !! Read masks
+      !! 
+      IF (l_grid_cdf) THEN
+         CALL flioopfd ('masks' // TRIM(c_suffix) // '.nc', il_mask)
+         CALL fliogetv (il_mask, TRIM(comod_t)//'.msk', i2o(:,:)) ; iomskt(:) = RESHAPE (i2o(:,:), (/jpon/))
+         CALL fliogetv (il_mask, TRIM(camod_t)//'.msk', i2a(:,:)) ; iamskt(:) = RESHAPE (i2a(:,:), (/jpan/))
+         CALL flioclo (il_mask)
+      ELSE
+         WRITE (unit = cfname, FMT='("masks.i", 1I1)' ) ik_in
+         OPEN (unit = nmsk, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read' )
+         CALL locrint (TRIM(comod_t)//'.msk', iomskt, jpon , nmsk, kerr, nout) ; IF (kerr /= 0) STOP 041
+         CALL locrint (TRIM(camod_t)//'.msk', iamskt, jpan , nmsk, kerr, nout) ; IF (kerr /= 0) STOP 061
+         !!
+      ENDIF
+      !!
+      !! Read grid box areas
+      !!
+      IF (l_grid_cdf) THEN
+         CALL flioopfd ( 'areas' // TRIM(c_suffix) // '.nc', il_area)
+         CALL fliogetv (il_area, TRIM(comod_t)//'.srf', z2o(:,:)) ; xosrft(:) = RESHAPE (z2o(:,:), (/ jpon /))
+         CALL fliogetv (il_area, TRIM(camod_t)//'.srf', z2a(:,:)) ; xasrft(:) = RESHAPE (z2a(:,:), (/ jpan /))
+         CALL flioclo (il_area)
+      ELSE
+         WRITE (unit = cfname, FMT='("areas.r", 1I1)' ) rk_in
+         OPEN (unit = nsrf, file = TRIM(cfname), position = 'rewind', form = 'unformatted', action = 'read' )
+         CALL locread (TRIM(comod_t)//'.srf', xosrft, jpon , nsrf, kerr, nout) ;  IF (kerr /= 0) STOP 081
+         CALL locread (TRIM(camod_t)//'.srf', xasrft, jpan , nsrf, kerr, nout) ;  IF (kerr /= 0) STOP 101
+         !!
+      ENDIF
+      !!
+      LecWeiPresent: IF (PRESENT (lecweights)) THEN 
+         LecWei: IF (lecweights) THEN 
+            !!
+            ko2a = 0 ; ka2o = 0 ; wa2o = 0.0_rl ; wo2a = 0.0_rl
+            !!
+
+
+            SELECT CASE ( TRIM ( c_read_wei) )
+            CASE ( 'oasis_3' ) 
+               cfname = TRIM(mo_name) // ".wa2o" // TRIM(c_suffix) // ".nc"
+               WRITE (nout,*) "Lecdata:  lecture des poids a2o format cdf"
+               WRITE (nout,*) "Lecdata, fichier poids : ", TRIM(cfname)
+               CALL flioopfd (TRIM(cfname), il_a2o)
+               CALL flioinqf (il_a2o, nb_dim=nb_dim )
+               ALLOCATE ( ln_dim (nb_dim))
+               CALL flioinqf (il_a2o, ln_dim=ln_dim )
+               WRITE (nout,*) 'Dimensions  ', nb_dim, ln_dim
+               CALL fliogetv (il_a2o, 'WEIGHTS2', wa2o(1:jma2o, 1:jpon) )
+               CALL fliogetv (il_a2o, 'ADRESSE2', ka2o(1:jma2o, 1:jpon) )
+               WRITE (nout,*) MINVAL (wa2o), MAXVAL(wa2o)
+               WRITE (nout,*) MINVAL (ka2o), MAXVAL(ka2o)
+               CALL flioclo (il_a2o)
+               DEALLOCATE (ln_dim)
+
+               cfname = TRIM(mo_name) // ".wo2a" // TRIM(c_suffix) // ".nc"
+               WRITE (nout,*) "Lecdata:  lecture des poids o2a format cdf"
+               WRITE (nout,*) "Lecdata, fichier poids : ", TRIM(cfname)
+               CALL flioopfd (TRIM(cfname), il_o2a)
+               CALL flioinqf (il_o2a, nb_dim=nb_dim )
+               ALLOCATE ( ln_dim (nb_dim))
+               CALL flioinqf (il_o2a, ln_dim=ln_dim )
+               WRITE (nout,*) 'Dimensions  ', nb_dim, ln_dim
+               
+               CALL fliogetv (il_o2a, 'WEIGHTS1', wo2a(1:jmo2a, 1:jpan) )
+               CALL fliogetv (il_o2a, 'ADRESSE1', ko2a(1:jmo2a, 1:jpan) )
+               WRITE (nout,*) MINVAL (wo2a), MAXVAL(wo2a)
+               WRITE (nout,*) MINVAL (ko2a), MAXVAL(ko2a)
+               CALL flioclo (il_o2a)
+               DEALLOCATE (ln_dim)
+               
+               !!
+            CASE ( 'oasis_2' )
+               WRITE (nout,*) "Lecdata:  lecture des poids format i4.r8"
+               WRITE(UNIT=nout,FMT=*) 'Lecdata-> ',         'kerr, nout, nwei8o2a'
+               WRITE(UNIT=nout,FMT='(" Lecdata-> ", 3I8)' )  kerr, nout, nwei8o2a
+               WRITE(UNIT=nout,FMT=*) 'Lecdata-> ',         'jpon, jpa2o, jma2o, jpon*jpa2o, jpon*jma2o, SIZE(ka2o), SIZE(wa2o)'
+               WRITE(UNIT=nout,FMT='(" Lecdata-> ", 7I9)' )  jpon, jpa2o, jma2o, jpon*jpa2o, jpon*jma2o, SIZE(ka2o), SIZE(wa2o)
+               WRITE(UNIT=nout,FMT=*) 'Lecdata-> ',         'jpan, jpo2a, jmo2a, jpan*jpo2a, jpan*jmo2a, SIZE(ko2a), SIZE(wo2a)'
+               WRITE(UNIT=nout,FMT='(" Lecdata-> ", 7I9)' )  jpan, jpo2a, jmo2a, jpan*jpo2a, jpan*jmo2a, SIZE(ko2a), SIZE(wo2a)
+               
+               clweight =  "WEIGHTS1" ; cladress = "ADRESSE1"
+               WRITE (UNIT=nout, FMT=*) 'Lecdata -> cladress : ', cladress
+               IF (ALLOCATED (k_t) ) DEALLOCATE (k_t)
+               ALLOCATE (k_t(jmo2a*jpan), STAT=ierr) ; CALL chk_allo (ierr, 'k_t(jmo2a*jpan)', lreset=.TRUE., crout='lecdata')
+               CALL locrint (cladress, k_t(1:jmo2a*jpan), jmo2a*jpan, nwei8o2a, kerr, nout) ;  IF (kerr /= 0) STOP 055
+               ko2a (1:jmo2a, 1:jpan) = RESHAPE (k_t (1: jpan * jmo2a), (/ jmo2a, jpan /))
+               DEALLOCATE (k_t)
+               WRITE (UNIT=nout, FMT=*) 'Lecdata -> clweight : ', clweight
+               IF (ALLOCATED (w_t) ) DEALLOCATE (w_t)
+               ALLOCATE (w_t (jmo2a*jpan), STAT=ierr) ; CALL chk_allo (ierr, 'w_t(jmo2a*jpan)')
+               CALL locread (clweight, w_t(1:jmo2a*jpan), jmo2a*jpan, nwei8o2a, kerr, nout) ;  IF (kerr /= 0) STOP 056
+               wo2a (1:jmo2a, 1:jpan) = RESHAPE (w_t (1: jpan * jmo2a), (/ jmo2a, jpan /))
+               DEALLOCATE (w_t)
+               !!  
+               clweight =  "WEIGHTS"//clw_num ; cladress = "ADRESSE"//clw_num
+               IF (ALLOCATED (k_t) ) DEALLOCATE (k_t)
+               ALLOCATE (k_t (jma2o*jpon), STAT=ierr) ; CALL chk_allo (ierr, 'k_t(jma2o*jpon)')
+               WRITE (UNIT=nout, FMT=*) 'Lecdata-> ', cladress
+               CALL locrint (cladress, k_t(1:jma2o*jpon), jma2o*jpon, nwei8a2o, kerr, nout) ;  IF (kerr /= 0) STOP 201
+               ka2o (1:jma2o, 1:jpon) = RESHAPE (k_t (1:jpon * jma2o) , (/ jma2o, jpon /))
+               DEALLOCATE (k_t)  
+               WRITE (UNIT=nout, FMT=*) clweight
+               IF (ALLOCATED (w_t) ) DEALLOCATE (w_t)
+               ALLOCATE (w_t (jma2o*jpon), STAT=ierr) ; CALL chk_allo (ierr, 'w_t(jma2o*jpon)')
+               CALL locread (clweight, w_t(1:jma2o*jpon), jma2o*jpon, nwei8a2o, kerr, nout) ;  IF (kerr /= 0) STOP 202
+               wa2o (1:jma2o, 1:jpon) = RESHAPE (w_t (1:jpon * jma2o) , (/ jma2o, jpon /))
+               DEALLOCATE (w_t)
+               CLOSE (unit = nwei8a2o)
+            CASE Default
+               WRITE (nout, *) 'Mauvais cas de lecture des poids '
+               STOP
+            END SELECT
+            !!
+         ENDIF LecWei
+      END IF LecWeiPresent
+      !!
+      IF (PRESENT (leco2amask) ) THEN 
+         IF (leco2amask) THEN 
+            !
+            ALLOCATE (zlon(jpai,jpaj) , zlat(jpai,jpaj) )
+            CALL flioopfd ('o2a.diag' // TRIM(c_suffix) // '.nc', nco2a)
+            CALL fliogetv (nco2a , 'OceMask', z2a)
+            CALL fliogetv (nco2a , 'nav_lon', zlon)
+            CALL fliogetv (nco2a , 'nav_lat', zlat)
+            ! Faut-il retourner o2amask ?
+            ylat1 = zlat(1,   1) ;  ylat2 = zlat(1,jpaj)
+            WRITE (nout,*) 'zlon, zlat : ', ylat1, ylat2
+            IF ( ABS (ylat1) .LT. 80. .OR. ABS (ylat2) .LT. 80. ) THEN
+               WRITE (nout, *) 'Erreur latitude dans o2amask) ' , ylat1, ylat2
+               STOP
+            END IF
+            IF (     ylat1 .LT. ylat2 .AND. .NOT. la_nortop &
+               .OR.  ylat1 .GT. ylat2 .AND.       la_nortop ) THEN
+               WRITE (nout,*) 'Retournement o2amask '
+               WRITE (nout,*) 'Retournement'
+               z2a (1:jpai, 1:jpaj) = z2a (1:jpai, jpaj:1:-1)
+               WRITE (nout,*) 'Reshape'
+               o2amask = RESHAPE (z2a (1:jpai, 1:jpaj), (/ jpan/) )
+               WRITE (nout,*) 'Fin Reshape'
+            ELSE
+               WRITE (nout,*) 'Pas de retournement o2amask '
+               o2amask = RESHAPE (z2a (1:jpai, 1:jpaj), (/ jpan/) )
+               WRITE (nout,*) 'Fin Reshape'
+            END IF
+       
+            o2amask_i_int = 1
+            o2amask_i_ext = 1
+            WHERE ( o2amask > 0.0_rl        ) o2amask_i_int = 0
+            WHERE ( o2amask > 1.0_rl-epsfrac) o2amask_i_ext = 0
+            CALL flioclo  (nco2a)
+
+            DEALLOCATE (zlon ,zlat)
+         END IF
+      END IF
+      !!
+      DEALLOCATE (z2o)
+      DEALLOCATE (z2a)
+      DEALLOCATE (i2o)
+      DEALLOCATE (i2a)
+      !!
+      WRITE (UNIT=nout, FMT=*) 'Fin Lecdata'
+      RETURN
+      !!
+   END SUBROUTINE lecdata
+END MODULE mod_lecdata
Index: /TOOLS/MOZAIC/src/MOZAIC/lecw.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lecw.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lecw.f90	(revision 3326)
@@ -0,0 +1,154 @@
+! -*- Mode: f90 -*- 
+!!! 
+!!! Test des fichiers de poids en lecture
+!!!
+MODULE d1
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: r4 = 4, r8 = 8, i4 = 4, i8 = 8
+  INTEGER, PARAMETER :: rl = r8, il = i4  ! Default types of all working fields
+  INTEGER, PARAMETER :: rk_in  = r8, ik_in  = i4 ! Data types in input files (masks, grids, areas)
+  INTEGER, PARAMETER :: rk_out = r8, ik_out = i4 ! Data types in output file (mozaic.w)
+  INTEGER (kind=il), PARAMETER :: nout = 6
+END MODULE d1
+!!
+MODULE com1
+  USE d1
+  IMPLICIT NONE
+  INTEGER (kind=il), PARAMETER :: jpoi = 92, jpoj = 76  ! Ocean model dimensions 
+  INTEGER (kind=il), PARAMETER :: jpai = 72, jpaj = 46  ! Atmosphere model dimensions
+  INTEGER (kind=il), PARAMETER :: jpon = jpoi * jpoj, jpan = jpai * jpaj ! Global (1D) dimensions
+  INTEGER (kind=il), PARAMETER :: jpo2a = 15, jpa2o = jpai	         ! Maximum number of possible neighbors
+  INTEGER (kind=il), PARAMETER :: jpanv = jpai * jpaj 
+  REAL (kind=rl)   , DIMENSION ( jpan*jpo2a) :: wo2a	  ! Weights of interpolation ocean -> atmosphere
+  INTEGER (kind=il), DIMENSION ( jpan*jpo2a) :: ko2a	  ! Adresses ocean -> atmosphere
+  REAL (kind=rl)   , DIMENSION ( jpon*jpa2o) :: wa2o	  ! Weights of interpolation atmosphere -> ocean
+  INTEGER (kind=il), DIMENSION ( jpon*jpa2o) :: ka2o	  ! Adresses atmosphere -> ocean
+END MODULE com1
+MODULE locio2
+CONTAINS
+  SUBROUTINE locread ( cdfldn, pfield, kdimax, knulre, kflgre, kout)
+    USE d1
+    IMPLICIT NONE
+    CHARACTER (LEN = 8), INTENT ( in) :: cdfldn ! Name of field to search for
+    INTEGER (kind=il), INTENT (  in) :: kdimax, knulre    ! Field dimension, unit to read
+    INTEGER (kind=il), INTENT (  in) :: kout              ! Standard output
+    INTEGER (kind=il), INTENT ( out) :: kflgre            ! Error status code
+    REAL (kind=rl)  , INTENT ( out), DIMENSION ( :) :: pfield ! Field
+    REAL (kind=rk_in), DIMENSION ( :), ALLOCATABLE :: ztemp
+    CHARACTER (len = 8) clecfl
+    INTEGER (kind=il) :: kerr
+    !
+    WRITE (UNIT = kout, FMT = '( "Locread :  Read field ", A8, " in unit = ", 1I6)' ) cdfldn, knulre
+    !
+    IF ( ALLOCATED ( ztemp)) DEALLOCATE ( ztemp)
+    ALLOCATE ( ztemp ( 1: kdimax), STAT = kerr )
+    IF ( kerr /= 0 ) THEN 
+        WRITE ( kout, *) 'Error allocating itemp in locread : ', kerr
+        kflgre = kerr
+        RETURN
+    END IF
+    !
+    REWIND ( UNIT = knulre)
+200 CONTINUE
+    READ (UNIT = knulre, ERR = 200, END = 210, IOSTAT = kerr) clecfl
+    IF ( clecfl /= cdfldn ) GO TO  200
+    READ (UNIT = knulre, IOSTAT = kerr) ztemp (1:kdimax)
+    IF ( kerr == 0 ) THEN 
+        pfield ( 1: kdimax) = REAL ( ztemp (1: kdimax), KIND = rl )
+    ELSE 
+        WRITE ( unit = kout, fmt = *) 'Problem reading field : ', kerr
+    END IF
+    DEALLOCATE ( ztemp)
+    kflgre = kerr
+    GO TO 220
+210 kflgre = 1
+    WRITE ( unit = kout, fmt = *) 'Problem in reading'
+220 CONTINUE
+    !
+    RETURN
+  END SUBROUTINE locread
+  !
+  SUBROUTINE locrint ( cdfldn, kfield, kdimax, knulre, kflgre, kout)
+    USE d1
+    !!
+    IMPLICIT none
+    !
+    CHARACTER (LEN = 8), INTENT ( in) :: cdfldn ! Name of field to search for
+    INTEGER (kind=il), INTENT (  in) :: kdimax, knulre    ! Field dimension, unit to read
+    INTEGER (kind=il), INTENT (  in) :: kout              ! Standard output
+    INTEGER (kind=il), INTENT ( out) :: kflgre            ! Error status code
+    INTEGER (kind=il), INTENT ( inout), DIMENSION (:) :: kfield ! Field
+    INTEGER (kind=ik_in), DIMENSION ( :), ALLOCATABLE :: itemp
+    !
+    CHARACTER (len = 8) :: clecfl
+    INTEGER (kind=il) :: kerr
+    !
+    WRITE (UNIT = kout, FMT = '( "Locrint :  Read field ", A8, " in unit = ", 1I6)' ) cdfldn, knulre
+    !
+    IF ( ALLOCATED ( itemp)) DEALLOCATE ( itemp)
+    ALLOCATE ( itemp ( 1: kdimax), STAT = kerr )
+    IF ( kerr /= 0 ) THEN 
+        WRITE ( kout, *) 'Error allocating itemp in locrint : ', kerr
+        kflgre = kerr
+        RETURN
+    END IF
+    !
+    REWIND ( UNIT = knulre )
+200 CONTINUE
+    !
+    READ (UNIT = knulre, ERR = 200, END = 210) clecfl
+    !
+    IF ( clecfl /= cdfldn ) GO TO  200
+    READ (UNIT = knulre, ERR = 200, END = 210, IOSTAT = kerr) itemp (1: kdimax)
+    IF ( kerr == 0 ) THEN
+        kfield (1: kdimax) = INT ( itemp (1: kdimax), KIND = il)
+    ELSE
+        WRITE ( unit = kout, fmt = *) 'Problem reading field : ', kerr
+    END IF
+    DEALLOCATE ( itemp)
+    kflgre = kerr
+    GO TO 220
+210 kflgre = 1
+    WRITE ( unit = kout, fmt = *) 'Problem in reading'
+    !
+220 CONTINUE
+    !
+    RETURN
+  END SUBROUTINE locrint
+  !!
+END MODULE locio2
+!!
+PROGRAM lecw
+  USE d1
+  USE com1
+  USE locio2
+  IMPLICIT NONE
+  INTEGER (kind=il) :: jma2o, jmo2a, nwei = 31, kerr
+  CHARACTER (len=8) :: clweight, cladress
+  !!
+  !! Lecture des poids
+  !!
+  OPEN ( unit = nwei, file = 'mozaic.w.runoff', form = 'unformatted', status = 'old', action = 'read')
+  !!
+  clweight =  "WEIGHTS1" ; cladress = "ADRESSE1" ; jmo2a = 15
+  WRITE ( unit = nout, fmt = *) cladress
+  CALL locrint ( cladress, ko2a, jpan * jmo2a , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 101
+  WRITE ( unit = nout, fmt = *) clweight
+  CALL locread ( clweight, wo2a, jpan * jmo2a , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 111
+  clweight =  "WEIGHTS2" ; cladress = "ADRESSE2" ; jma2o = 72
+  WRITE ( unit = nout, fmt = *) cladress
+  CALL locrint ( cladress, ka2o, jpon * jma2o , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 102
+  WRITE ( unit = nout, fmt = *) clweight
+  CALL locread ( clweight, wa2o, jpon * jma2o , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 112
+  clweight =  "WEIGHTS3" ; cladress = "ADRESSE3" ; jma2o = 3
+  WRITE ( unit = nout, fmt = *) cladress
+  CALL locrint ( cladress, ka2o, jpon * jma2o , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 103
+  WRITE ( unit = nout, fmt = *) clweight
+  CALL locread ( clweight, wa2o, jpon * jma2o , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 113
+  clweight =  "WEIGHTS4" ; cladress = "ADRESSE4" ; jma2o = 5
+  WRITE ( unit = nout, fmt = *) cladress
+  CALL locrint ( cladress, ka2o, jpon * jma2o , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 104
+  WRITE ( unit = nout, fmt = *) clweight
+  CALL locread ( clweight, wa2o, jpon * jma2o , nwei, kerr, nout) ;  IF ( kerr /= 0 ) STOP 114
+  !!
+END PROGRAM lecw
Index: /TOOLS/MOZAIC/src/MOZAIC/lmdz.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/lmdz.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/lmdz.f90	(revision 3326)
@@ -0,0 +1,676 @@
+! -*- Mode: f90 -*-
+PROGRAM lmdgrille
+!!!
+!!! Ecris les grilles LMDZ au format OASIS
+   !!
+   !! Attention : 
+   !!  pour OASIS 3, le nord est en haut (j=jpai) et le sud en bas (j=1)
+   !!  pour OASI3-MCT, il faut conserver le sens du modèle
+   !!
+   !! Unite IEEE : 32 
+   !!
+   USE declare
+   USE dimensions
+   USE mod_prih
+   USE fliocom
+   USE getincom
+   USE errioipsl
+   USE mod_inipar
+   IMPLICIT none
+   !!
+   INTEGER (kind=il) :: jai, jaj, jk, jc
+   REAL (kind=rl), DIMENSION (:, :), ALLOCATABLE :: xlont, xlatt, xlonu, xlatu, xlonv, xlatv, xlonf, xlatf
+   REAL (kind=rl), DIMENSION (:, :), ALLOCATABLE :: xlat_o2a
+   REAL (kind=rl), DIMENSION (:, :), ALLOCATABLE :: xmas, xare, xtmp, xfra
+   REAL (kind=rl), DIMENSION (:, :, :), ALLOCATABLE :: xclon, xclat
+   REAL (kind=rl), DIMENSION (:, :), ALLOCATABLE :: xaw, xae, yan, yas
+   INTEGER (kind=il) :: id_restart, id_restartphy, id_hist, id_grid, id_coo, no = 32, narg = 0, iargc
+   REAL (kind=rl) :: ra, zzz, xdel, ydel
+   CHARACTER (len=180) :: cfname, clmd, c_restart, c_restartphy, c_hist
+   CHARACTER (len=80) :: cmodel
+   CHARACTER (len=8) :: clon, clat, cmsk, csrf, clarg
+   REAL (kind=rl), DIMENSION (:, :), ALLOCATABLE :: flux_iceberg
+   INTEGER :: ia_sk=1_il, ja_sk=1_il
+   INTEGER :: nlmd
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: tab1d
+   !!
+   INTEGER (kind=il) :: il_grid, il_mask, il_area, il_frac, id
+   INTEGER (kind=il) :: ierr
+   !
+   LOGICAL :: l_build   = .FALSE.  !< Construction a partir de rien
+   LOGICAL :: l_restart = .FALSE.  !< Construction a partir de restart et restartphy
+   LOGICAL :: l_read    = .FALSE.  !< Construction a partir de grids.nc, areas.nc, masks.nc
+   !LOGICAL :: lec_msk = .TRUE., lec_srf = .TRUE., lec_coo = .TRUE., lec_fra = .TRUE.
+   LOGICAL :: la_retourn_lat !< Retournement nor/sud des champs lmdz
+   CHARACTER (LEN=1) :: cl_rk
+   !!
+   CALL inipar
+   
+   !!
+   IF ( jpai .GT. 100_il ) ia_sk =  2
+   IF ( jpai .GT. 200_il ) ia_sk =  5
+   IF ( jpai .GT. 500_il ) ia_sk = 10
+
+   IF ( jpaj .GT. 100_il ) ia_sk =  2
+   IF ( jpaj .GT. 200_il ) ja_sk =  5
+   IF ( jpaj .GT. 500_il ) ja_sk = 10
+   !!
+   ALLOCATE (xlont (jpai , jpaj ), STAT=ierr) ; CALL chk_allo (ierr, 'xlont', lreset=.TRUE., crout='lmdz')
+   ALLOCATE (xlatt (jpai , jpaj ), STAT=ierr) ; CALL chk_allo (ierr, 'xlatt')
+   ALLOCATE (xlonu (jpaiu, jpaju), STAT=ierr) ; CALL chk_allo (ierr, 'xlonu')
+   ALLOCATE (xlatu (jpaiu, jpaju), STAT=ierr) ; CALL chk_allo (ierr, 'xlatu')
+   ALLOCATE (xlonv (jpaiv, jpajv), STAT=ierr) ; CALL chk_allo (ierr, 'xlonv')
+   ALLOCATE (xlatv (jpaiv, jpajv), STAT=ierr) ; CALL chk_allo (ierr, 'xlatv')
+   ALLOCATE (xmas  (jpai , jpaj ), STAT=ierr)  ; CALL chk_allo (ierr, 'xmas')
+   ALLOCATE (xare  (jpai , jpaj ), STAT=ierr)  ; CALL chk_allo (ierr, 'xare')
+   ALLOCATE (xfra  (jpai , jpaj ), STAT=ierr)  ; CALL chk_allo (ierr, 'xfra')
+   ALLOCATE (xtmp  (jpai , jpaj )) ; CALL chk_allo (ierr, 'xtmp')
+   ALLOCATE (xclon (jpai , jpaj, 4), STAT=ierr) ; CALL chk_allo (ierr, 'xclon')
+   ALLOCATE (xclat (jpai , jpaj, 4), STAT=ierr) ; CALL chk_allo (ierr, 'xclat')
+   ALLOCATE (xaw   (jpai , jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'xaw')
+   ALLOCATE (xae   (jpai , jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'xae')
+   ALLOCATE (yan   (jpai , jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'yan')
+   ALLOCATE (yas   (jpai , jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'yas')
+   ALLOCATE (flux_iceberg (jpai, jpaj)) ; CALL chk_allo (ierr, 'flux_iceberg')
+
+   !!
+   ra =  r_earth
+   !!
+   clon = 'nav_lon' ; clat = 'nav_lat' ; cmsk = 'msks' ; csrf = 'aire' ; clmd =  'grillelmd.nc'
+   !!
+   !CALL ipsldbg (.TRUE.)
+   !!
+   WRITE (UNIT=cmodel, FMT='("LMDZ ", 1I3.3, "x", 1I3.3 )') jpai, jpaj
+   WRITE ( nout, *) cmodel
+   !!
+   !! Lecture de la ligne de commande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE ('-b')
+         l_build = .TRUE.
+   
+      CASE ('-l')
+         l_restart = .TRUE. 
+         c_restart    = 'restart.nc'
+         c_restartphy = 'restartphy.nc'
+!-$$         c_hist       = 'histmth.nc'
+!-$$         csrf         = 'AIRE'
+         c_hist       = 'gridarea_zoom_correct.nc'
+         csrf         = 'area'
+         WRITE ( nout, *) 'Lecture LMDZ dans restart : ', TRIM (c_restart)
+
+      CASE ('-r') 
+         l_read  = .TRUE. 
+         clmd = 'o2a.diag.nc' 
+         cmsk = 'OceMask' ; csrf = 'Surface' 
+         WRITE ( nout, *) 'Relecture du masque calcule par mozaic'
+
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !!
+   WRITE ( nout,*) 'Dimension atmopshere : ', jpai, jpaj, jpan
+   WRITE ( nout,*) 'Dimension ocean      : ', jpoi, jpoj, jpon
+!-$$   WRITE ( nout,*) 'Lecture mask  : ', lec_msk
+!-$$   WRITE ( nout,*) 'Lecture coord : ', lec_coo
+   !!
+   !!
+   WRITE ( unit = cl_rk, fmt = '(1I1)' ) rk_in
+   cfname = 'lmd.grids' // TRIM (c_suffix) // '.r' // cl_rk
+   OPEN ( unit = no, file = TRIM(cfname), form = 'unformatted', action = 'write', position = 'rewind', status = 'unknown' )
+   !
+   !CALL ipsldbg ( .TRUE. )
+   !!
+   IF ( l_build ) THEN
+      WRITE (nout,*) 'Construction de la grille ex nihilo'
+      ! Lon, lat - regulier uniquement
+      ! Contruction avec le Sud en bas de la carte
+      DO jai = 1, jpai
+         xlont (jai,:) = -180.0_rl + (REAL (jai-1, rl)        ) / REAL (jpai  , rl) * 360.0_rl
+         xaw   (jai,:) = -180.0_rl + (REAL (jai-1, rl)-0.5_rl ) / REAL (jpai  , rl) * 360.0_rl
+         xae   (jai,:) = -180.0_rl + (REAL (jai-1, rl)+0.5_rl ) / REAL (jpai  , rl) * 360.0_rl
+      END DO
+      
+      DO jaj = 1, jpaj
+         xlatt (:,jaj) =   90.0_rl - ( REAL (jaj-1, rl)        ) / REAL (jpaj-1, rl) * 180.0_rl
+         yas   (:,jaj) =   90.0_rl - ( REAL (jaj-1, rl)+0.5_rl ) / REAL (jpaj-1, rl) * 180.0_rl
+         yan   (:,jaj) =   90.0_rl - ( REAL (jaj-1, rl)-0.5_rl ) / REAL (jpaj-1, rl) * 180.0_rl
+      END DO
+      !
+      yas = MIN ( 90.0_rl, MAX (-90.0_rl, yas))
+      yan = MIN ( 90.0_rl, MAX (-90.0_rl, yan))
+      !
+      xclon (:,:,1) = xae
+      xclon (:,:,2) = xaw
+      xclon (:,:,3) = xaw
+      xclon (:,:,4) = xae
+      !
+      xclat (:,:,1) = yas
+      xclat (:,:,2) = yas
+      xclat (:,:,3) = yan
+      xclat (:,:,4) = yan
+      
+      DO jk = 1, 4
+         xclon(:,:,jk) = clo_lon ( xclon(:,:,jk), xlont(:,:) )
+      END DO
+      
+      ! Masque et fractions
+      xmas = 0.0_rl
+      xfra = 1.0_rl
+
+      ! Surfaces
+      CALL surface ( 'globe' )
+
+   END IF
+   
+   IF ( l_restart ) THEN
+      !! Lecture restart LMDZ : le sud est en bas
+      nlmd =  jpait*(jpajv-1) + 2
+      WRITE (nout,*) 'Lecture restart LMD '
+      WRITE (nout,*) 'Dimension 1D : ', nlmd
+      ALLOCATE ( tab1d (nlmd)) ; CALL chk_allo (ierr, 'tab1d')
+      CALL flioopfd ( TRIM(c_restart)   , id_restart)
+      CALL flioopfd ( TRIM(c_restartphy), id_restartphy)
+      !
+      WRITE (nout,*) 'Lecture longitude ', jpait*(jpajv-1), (/jpait, jpajv-1/)
+      CALL fliogetv (id_restartphy, 'longitude', tab1d (:))
+      xlont (:,2:jpai-1) = RESHAPE ( tab1d (2:nlmd-1), (/jpait, jpajv-1/) )
+      xlont (:, 1  ) = xlont (:,jpaj/2)
+      xlont (:,jpaj) = xlont (:,jpaj/2)
+      WRITE (nout,*) 'Lecture latitude ', jpait*(jpajv-1), (/jpait, jpajv-1/) 
+      CALL fliogetv (id_restartphy, 'latitude' , tab1d (:))
+      xlatt (:,2:jpai-1) = RESHAPE ( tab1d (2:nlmd-1), (/jpait, jpajv-1/) )
+      xlatt (:,1) = 90.0_rl ; xlatt (:,jpaj) = -90.0_rl
+
+      WRITE (nout,*) 'Lecture FOCE ', jpait*(jpajv-1), (/jpait, jpajv-1/)
+      CALL fliogetv (id_restartphy, 'FOCE' , tab1d (:))
+      xfra (:,2:jpai-1) = RESHAPE ( tab1d (1:nlmd-1), (/jpait, jpajv-1/) )
+      WRITE (nout,*) 'Lecture FSIC ', jpait*(jpajv-1), (/jpait, jpajv-1/)
+      CALL fliogetv (id_restartphy, 'FSIC' , tab1d (:))
+      xfra (:,2:jpai-1) = xfra (:,2:jpai-1) & 
+         &              + RESHAPE ( tab1d (1:nlmd-1), (/jpait, jpajv-1/) )
+      xfra (:, 1   ) = 1.0_rl
+      xfra (:, jpaj) = 0.0_rl
+
+      xmas (:,:) = 1.0_rl
+      WHERE ( xfra (:,:) .GT. 0.0_rl) xmas (:,:) = 0.0_rl
+
+      CALL fliogetv (id_restart, 'rlonu', xlonu(:,1) )
+      CALL fliogetv (id_restart, 'rlatu', xlatu(1,:) )
+      CALL fliogetv (id_restart, 'rlonv', xlonv(:,1) )
+      CALL fliogetv (id_restart, 'rlatv', xlatv(1,:) )
+
+      ! Eventuellement conversion
+      IF ( MAXVAL(ABS(xlonu)) .LT. 10.0_rl ) THEN 
+         xlonu (:,:) = SPREAD ( xlonu(:,1), DIM=2, ncopies=jpaju) * dar
+         xlatu (:,:) = SPREAD ( xlatu(1,:), DIM=1, ncopies=jpaiu) * dar
+         xlonv (:,:) = SPREAD ( xlonv(:,1), DIM=2, ncopies=jpajv) * dar
+         xlatv (:,:) = SPREAD ( xlatv(1,:), DIM=1, ncopies=jpaiv) * dar
+      END IF
+
+      !
+      xaw  (2:jpai  ,:) = xlonu (1:jpai-1,1:jpaj)
+      xaw  (1       ,:) = xlonu (jpai    ,1:jpaj) - 360.0_rl
+
+      xae  (1:jpai  ,:) = xlonu (1:jpai  ,1:jpaj)
+
+      !
+      yan (1:jpai,2:jpaj  ) = xlatv(1:jpai,1:jpaj-1)
+      yan ( :    ,  1     ) = 90.0_rl
+
+      yas (1:jpai,1:jpaj-1) = xlatv (1:jpai, 1:jpaj-1)
+      yas ( :    ,jpaj    ) = -90.0_rl
+
+      xclon (:,:,1) = xae
+      xclon (:,:,2) = xaw
+      xclon (:,:,3) = xaw
+      xclon (:,:,4) = xae
+      !
+      xclat (:,:,1) = yas
+      xclat (:,:,2) = yas
+      xclat (:,:,3) = yan
+      xclat (:,:,4) = yan
+
+      ! Surfaces
+      WRITE (nout,*) 'Lecture hist LMD ', TRIM(c_hist)
+      CALL flioopfd ( TRIM(c_hist), id_hist)
+      !
+      CALL fliogetv (id_hist, TRIM(csrf), xare(:,:), start=(/1,1,1/), count=(/jpai,jpaj,1/) )
+      
+      !! Bug surface dans le zoom de Yves et Rng
+      !CALL surface ( 'pole' )
+      
+   ENDIF
+
+   IF ( l_read ) THEN
+      ! Le sud n'est pas forcement au bon endroit
+      CALL flioopfd ('grids' // TRIM(c_suffix) // '.nc', id)
+      CALL fliogetv (id, 'tlmd.lon', xlont)
+      CALL fliogetv (id, 'tlmd.lat', xlatt)
+      CALL fliogetv (id, 'tlmd.clo', xclon)
+      CALL fliogetv (id, 'tlmd.cla', xclat)
+      CALL flioclo (id)
+      
+      CALL flioopfd ('areas' // TRIM(c_suffix) // '.nc', id)
+      CALL fliogetv (id, 'tlmd.srf', xare)
+      CALL flioclo (id)
+      
+      WRITE ( nout, *) 'Lecture des fractions dans ' // TRIM(clmd) // ' variable ' // TRIM(cmsk) 
+      ! Les fractions ne sont pas forcément dans le même sens que les autres fichiers ... !
+      CALL flioopfd ( TRIM (clmd), id)
+      CALL fliogetv ( id, TRIM (cmsk), xfra)
+      WRITE ( UNIT = nout, fmt = *) 'Msk lmd ', TRIM ( cmsk)
+      CALL prihre ( xfra, 1.0_rl, nout)
+      IF ( TRIM (cmsk) == 'phis' ) THEN
+         xtmp = xmas
+         xmas = 0.0_rl
+         WHERE ( xtmp .GT. 0.1_rl ) xmas = 1.0_rl
+         xfra = xtmp
+      END IF
+      IF ( TRIM (cmsk) == 'OceMask' ) THEN
+         xmas = 0.0_rl
+         WHERE ( xfra .EQ. 0.0_rl ) xmas = 1.0_rl
+         ALLOCATE ( xlat_o2a(jpai,jpaj))
+         CALL fliogetv ( id, 'nav_lat', xlat_o2a)
+         !
+         IF (     xlat_o2a(jpai/2,1) .LT.  xlat_o2a(jpai/2,jpaj) .AND. xlatt(jpai/2,1) .GT. xlatt(jpai/2,jpaj) &
+            .OR.  xlat_o2a(jpai/2,1) .GT.  xlat_o2a(jpai/2,jpaj) .AND. xlatt(jpai/2,1) .LT. xlatt(jpai/2,jpaj) ) THEN
+            xfra ( :,:) = xfra (:, jpaj:1:-1) 
+            xmas ( :,:) = xmas (:, jpaj:1:-1) 
+         END IF
+      END IF
+   END IF
+   !!
+   !! Inversion eventuelle des indices J
+   !!
+   IF ( la_nortop ) THEN 
+      WRITE (unit = nout, fmt = *) "Cas nord en haut"
+      IF ( xlatt(jpai/2,1) .GT. xlatt(jpai/2,jpaj) ) THEN 
+         WRITE (nout,*) "Il faut retourner les indices J"
+         la_retourn_lat  = .TRUE.
+      ELSE 
+         WRITE (nout,*) "Indices J dans le bon ordre"
+         la_retourn_lat  = .FALSE.
+      END IF
+   ELSE 
+      WRITE (unit = nout, fmt = *) "Cas nord en bas"
+      IF ( xlatt(jpai/2,1) .LT. xlatt(jpai/2,jpaj) ) THEN 
+         WRITE (nout,*) "Il faut retourner les indices J"
+         la_retourn_lat  = .TRUE.
+      ELSE 
+         WRITE (nout,*) "Indices J dans le bon ordre"
+         la_retourn_lat  = .FALSE.
+      END IF
+   END IF
+
+   IF ( la_retourn_lat ) THEN 
+      WRITE (nout,*) "Retournement des indices J"
+      xlont (:,:)   =  xlont (1:jpai , jpaj :1:-1)
+      xlonu (:,:)   =  xlonu (1:jpaiu, jpaju:1:-1)
+      xlonv (:,:)   =  xlonv (1:jpaiv, jpajv:1:-1)
+      xlatt (:,:)   =  xlatt (1:jpai , jpaj :1:-1)
+      xlatu (:,:)   =  xlatu (1:jpaiu, jpaju:1:-1)
+      xlatv (:,:)   =  xlatv (1:jpaiv, jpajv:1:-1)
+      xmas  (:,:)   =  xmas  (1:jpai , jpaj :1:-1)
+      xfra  (:,:)   =  xfra  (1:jpai , jpaj :1:-1)
+      xare  (:,:)   =  xare  (1:jpai , jpaj :1:-1)
+      xclon (:,:,:) =  xclon (1:jpai , jpaj :1:-1,:)
+      xclat (:,:,:) =  xclat (1:jpai , jpaj :1:-1,:)
+
+      xaw   (:,:)   =  xaw   (1:jpai , jpaj :1:-1)
+      xae   (:,:)   =  xae   (1:jpai , jpaj :1:-1)
+      yas   (:,:)   =  yas   (1:jpai , jpaj :1:-1)
+      yan   (:,:)   =  yan   (1:jpai , jpaj :1:-1)
+
+      xclon (:,:,1) = xaw (:,:) 
+      xclon (:,:,2) = xae (:,:) 
+      xclon (:,:,3) = xae (:,:) 
+      xclon (:,:,4) = xaw (:,:) 
+      !
+      xclat (:,:,1) = yan (:,:) 
+      xclat (:,:,2) = yan (:,:) 
+      xclat (:,:,3) = yas (:,:) 
+      xclat (:,:,4) = yas (:,:) 
+
+   END IF
+
+   WRITE ( unit = nout, fmt = *) 'Longitudes T'
+   CALL prihre ( xlont, 1._rl, nout)
+
+   WRITE ( unit = no) 't'//TRIM(camod)//'.lon'
+   WRITE ( unit = no) REAL ( xlont(1:jpai,1:jpaj), kind = rk_in )
+   !
+   WRITE ( unit = nout, fmt = *) 'Latitudes T'
+   CALL prihre ( xlatt, 1._rl, nout)
+
+   WRITE ( unit = no) 't'//TRIM(camod)//'.lat'
+   WRITE ( unit = no) REAL (xlatt(1:jpai,1:jpaj), kind = rk_in )
+   !
+   WRITE ( unit = nout, fmt = *) 'Corners'
+   WRITE ( unit = no) 't'//TRIM(camod)//'.clo'
+   WRITE ( unit = no) REAL (xclon, kind = rk_in )
+   WRITE ( unit = no) 't'//TRIM(camod)//'.cla'
+   WRITE ( unit = no) REAL (xclat, kind = rk_in )
+
+   DO jc = 1, 4
+      WRITE ( unit = nout, fmt = *) 'Coins - Longitudes ', jc
+      CALL prihre ( xclon(:,:,jc), 1._rl, nout)
+      WRITE ( unit = nout, fmt = *) 'Coins - Latitudes ', jc
+      CALL prihre ( xclat(:,:,jc), 1._rl, nout)
+   END DO 
+
+   WRITE ( unit = nout, fmt = *) 'Fractions (%)'
+   CALL prihre ( xfra, 100.0_rl, nout)
+
+   WRITE ( unit = nout, fmt = *) 'Surface '
+   CALL prihre (xare, 0.0_rl, nout)
+   zzz = SUM ( xare) / ( ra * ra * rpi * 4.0_rl )
+   WRITE (UNIT = nout, FMT = *) 'Surface normalisee : ', zzz
+
+   !!
+   !! Ecriture OASIS NetCDF
+   CALL fliocrfd ( 'lmd.grids' // TRIM(c_suffix), (/'jpia   ', 'jpja   ', 'corners'/), (/jpai, jpaj, 4/), il_grid, mode='REPLACE')
+   CALL flioputa ( il_grid, '?', 'Model', cmodel)
+   CALL flioputa ( il_grid, '?', 'Comment', TRIM(c_comment) )
+
+   CALL fliodefv ( il_grid, 'tlmd.lon', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'tlmd.lon', 'units'     , 'degrees_east' )
+   CALL flioputa ( il_grid, 'tlmd.lon', 'title'     , 'lmdz-t longitudes' )
+   CALL flioputa ( il_grid, 'tlmd.lon', 'grid_type' , 'P' )
+   CALL flioputa ( il_grid, 'tlmd.lon', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'tlmd.lat', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'tlmd.lat', 'units'    , 'degrees_north' )
+   CALL flioputa ( il_grid, 'tlmd.lat', 'title'     ,'lmdz-t latitudes' )
+   CALL flioputa ( il_grid, 'tlmd.lat', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'tlmd.lat', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'tlmd.clo', (/1, 2, 3/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'tlmd.clo', 'units'    , 'degrees_east' )
+   CALL flioputa ( il_grid, 'tlmd.clo', 'title'     ,'Longitudes for t-cell corner' )
+   CALL flioputa ( il_grid, 'tlmd.clo', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'tlmd.clo', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'tlmd.cla', (/1, 2, 3/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'tlmd.cla', 'units'    , 'degrees_north' )
+   CALL flioputa ( il_grid, 'tlmd.cla', 'title'     ,'Latitudes for t-cell corner' )
+   CALL flioputa ( il_grid, 'tlmd.cla', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'tlmd.cla', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'aone.lon', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'aone.lon', 'units'     , 'degrees_east' )
+   CALL flioputa ( il_grid, 'aone.lon', 'title'     , 'lmdz-t longitudes' )
+   CALL flioputa ( il_grid, 'aone.lon', 'grid_type' , 'P' )
+   CALL flioputa ( il_grid, 'aone.lon', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'aone.lat', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'aone.lat', 'units'    , 'degrees_north' )
+   CALL flioputa ( il_grid, 'aone.lat', 'title'     ,'lmdz-t latitudes' )
+   CALL flioputa ( il_grid, 'aone.lat', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'aone.lat', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'aone.clo', (/1, 2, 3/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'aone.clo', 'units'    , 'degrees_east' )
+   CALL flioputa ( il_grid, 'aone.clo', 'title'     ,'Longitudes for t-cell corner' )
+   CALL flioputa ( il_grid, 'aone.clo', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'aone.clo', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'aone.cla', (/1, 2, 3/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'aone.cla', 'units'    , 'degrees_north' )
+   CALL flioputa ( il_grid, 'aone.cla', 'title'     ,'Latitudes for t-cell corner' )
+   CALL flioputa ( il_grid, 'aone.cla', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'aone.cla', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'afra.lon', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'afra.lon', 'units'     , 'degrees_east' )
+   CALL flioputa ( il_grid, 'afra.lon', 'title'     , 'lmdz-t longitudes' )
+   CALL flioputa ( il_grid, 'afra.lon', 'grid_type' , 'P' )
+   CALL flioputa ( il_grid, 'afra.lon', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'afra.lat', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'afra.lat', 'units'    , 'degrees_north' )
+   CALL flioputa ( il_grid, 'afra.lat', 'title'     ,'lmdz-t latitudes' )
+   CALL flioputa ( il_grid, 'afra.lat', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'afra.lat', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'afra.clo', (/1, 2, 3/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'afra.clo', 'units'    , 'degrees_east' )
+   CALL flioputa ( il_grid, 'afra.clo', 'title'     ,'Longitudes for t-cell corner' )
+   CALL flioputa ( il_grid, 'afra.clo', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'afra.clo', 'overlap'   , 0_i_4 )
+
+   CALL fliodefv ( il_grid, 'afra.cla', (/1, 2, 3/), v_t=flio_r8 )
+   CALL flioputa ( il_grid, 'afra.cla', 'units'    , 'degrees_north' )
+   CALL flioputa ( il_grid, 'afra.cla', 'title'     ,'Latitudes for t-cell corner' )
+   CALL flioputa ( il_grid, 'afra.cla', 'grid_type' ,'P' )
+   CALL flioputa ( il_grid, 'afra.cla', 'overlap'   , 0_i_4 )
+
+   CALL flioputv ( il_grid, 'tlmd.lon', xlont )
+   CALL flioputv ( il_grid, 'tlmd.lat', xlatt )
+   CALL flioputv ( il_grid, 'tlmd.clo', xclon )
+   CALL flioputv ( il_grid, 'tlmd.cla', xclat )
+   CALL flioputv ( il_grid, 'aone.lon', xlont )
+   CALL flioputv ( il_grid, 'aone.lat', xlatt )
+   CALL flioputv ( il_grid, 'aone.clo', xclon )
+   CALL flioputv ( il_grid, 'aone.cla', xclat )
+   CALL flioputv ( il_grid, 'afra.lon', xlont )
+   CALL flioputv ( il_grid, 'afra.lat', xlatt )
+   CALL flioputv ( il_grid, 'afra.clo', xclon )
+   CALL flioputv ( il_grid, 'afra.cla', xclat )
+   !
+   CALL flioclo ( il_grid)
+   !
+   CLOSE ( unit = no)
+   !!
+   WRITE ( unit = nout, fmt = *) 'Masque atm ', i_4
+   WRITE ( unit = cl_rk, fmt = '(1I1)' ) i_4
+   cfname = 'lmd.masks' // TRIM (c_suffix) // '.i' // cl_rk
+   OPEN ( unit = no, file = cfname, form = 'unformatted', action = 'write', position = 'rewind', status = 'unknown' )
+   CALL prihin ( INT (xmas,KIND=il), 1_il, nout)
+   WRITE ( unit = no) 't'//TRIM(camod)//'.msk'
+   WRITE ( unit = no) INT ( xmas, KIND = i_4)
+   WRITE ( unit = no) 'u'//TRIM(camod)//'.msk'
+   WRITE ( unit = no) INT ( xmas, KIND = i_4)
+   WRITE ( unit = no) 'v'//TRIM(camod)//'.msk'
+   WRITE ( unit = no) INT ( xmas, KIND = i_4)
+   CLOSE ( unit = no)
+   !!
+   WRITE ( unit = nout, fmt = *) 'Masque atm ', i_8
+   WRITE ( unit = cl_rk, fmt = '(1I1)' ) i_8
+   cfname = 'lmd.masks' // TRIM (c_suffix) // '.i' // cl_rk
+   OPEN ( unit = no, file = cfname, form = 'unformatted', action = 'write', position = 'rewind', status = 'unknown' )
+   CALL prihin ( INT (xmas,KIND=il), 1_il, nout)
+   WRITE ( unit = no) 't'//TRIM(camod)//'.msk'
+   WRITE ( unit = no) INT ( xmas, KIND = i_8)
+   WRITE ( unit = no) 'u'//TRIM(camod)//'.msk'
+   WRITE ( unit = no) INT ( xmas, KIND = i_8)
+   WRITE ( unit = no) 'v'//TRIM(camod)//'.msk'
+   WRITE ( unit = no) INT ( xmas, KIND = i_8)
+   CLOSE ( unit = no)
+   !!
+   CALL fliocrfd ( 'lmd.masks' // TRIM(c_suffix), (/'jpia', 'jpja' /), (/jpai, jpaj/), il_mask, mode='REPLACE' )
+   CALL flioputa ( il_mask, '?', 'Model', cmodel )
+   CALL flioputa ( il_mask, '?', 'Comment', TRIM(c_comment) )
+
+   CALL fliodefv ( il_mask, 'tlmd.msk', (/1, 2/), v_t=flio_i4 )
+   CALL flioputa ( il_mask, 'tlmd.msk', 'units'     , 'n' )
+   CALL flioputa ( il_mask, 'tlmd.msk', 'land_value', 1_i_4)
+   CALL flioputa ( il_mask, 'tlmd.msk', 'sea_value' , 0_i_4)
+   CALL flioputa ( il_mask, 'tlmd.msk', 'title'     , 'lmdz-t land-sea mask' )
+
+   CALL fliodefv ( il_mask, 'aone.msk', (/1, 2/), v_t=flio_i4 )
+   CALL flioputa ( il_mask, 'aone.msk', 'units'     , 'n' )
+   CALL flioputa ( il_mask, 'aone.msk', 'land_value', 1_i_4)
+   CALL flioputa ( il_mask, 'aone.msk', 'sea_value' , 0_i_4)
+   CALL flioputa ( il_mask, 'aone.msk', 'title'     , 'lmdz-t land-sea mask, forced to not masked' )
+
+   CALL fliodefv ( il_mask, 'afra.msk', (/1, 2/), v_t=flio_i4 )
+   CALL flioputa ( il_mask, 'afra.msk', 'units'     , 'n' )
+   CALL flioputa ( il_mask, 'afra.msk', 'land_value', 1_i_4)
+   CALL flioputa ( il_mask, 'afra.msk', 'sea_value' , 0_i_4)
+   CALL flioputa ( il_mask, 'afra.msk', 'title'     , 'lmdz-t land-sea mask' )
+
+   !!
+   CALL flioputv ( il_mask, 'tlmd.msk', xmas )
+   CALL flioputv ( il_mask, 'aone.msk', 0.0*xmas )
+   CALL flioputv ( il_mask, 'afra.msk', xmas )
+
+   CALL flioclo ( il_mask )
+   !!
+   WRITE ( unit = cl_rk, fmt = '(1I1)' ) rk_in
+   cfname = 'lmd.areas' // TRIM (c_suffix) // '.r' // cl_rk
+   OPEN ( unit = no, file = cfname, form = 'unformatted', action = 'write', position = 'rewind', status = 'unknown' )
+   !
+
+   WRITE (unit = no) 't'//TRIM(camod)//'.srf'
+   WRITE (unit = no) REAL ( xare, KIND = rk_in)
+   !
+   CLOSE ( unit = no)
+   !!
+   CALL fliocrfd ( 'lmd.areas' // TRIM(c_suffix), (/'jpia', 'jpja' /), (/jpai, jpaj/), il_area, mode='REPLACE' )
+   CALL flioputa ( il_area, '?', 'Model', cmodel )
+   CALL flioputa ( il_area, '?', 'Comment', TRIM(c_comment) )
+
+   CALL fliodefv ( il_area, 'tlmd.srf', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_area, 'tlmd.srf', 'units'  , 'm^2' )
+   CALL flioputa ( il_area, 'tlmd.srf', 'title', 'lmdz-t mesh surface')
+
+   CALL fliodefv ( il_area, 'aone.srf', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_area, 'aone.srf', 'units'  , 'm^2' )
+   CALL flioputa ( il_area, 'aone.srf', 'title', 'lmdz-t mesh surface, set to 1')
+
+   CALL fliodefv ( il_area, 'afra.srf', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_area, 'afra.srf', 'units'  , 'm^2' )
+   CALL flioputa ( il_area, 'afra.srf', 'title', 'lmdz-t mesh surface, set to 1')
+
+   CALL flioputv ( il_area, 'tlmd.srf', xare )
+   CALL flioputv ( il_area, 'aone.srf', 1.0_rl + 0.0_rl*xare )
+   CALL flioputv ( il_area, 'afra.srf', xare*xfra )
+
+   CALL flioclo ( il_area)
+   !
+   !!
+   CALL fliocrfd ( 'lmd.fracs' // TRIM(c_suffix), (/'jpia', 'jpja' /), (/jpai, jpaj/), il_frac, mode='REPLACE' )
+   CALL flioputa ( il_frac, '?', 'Model', cmodel )
+   CALL flioputa ( il_frac, '?', 'Comment', TRIM(c_comment) )
+
+   CALL fliodefv ( il_frac, 'tlmd.fra', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_frac, 'tlmd.fra', 'units'  , 'm^2' )
+   CALL flioputa ( il_frac, 'tlmd.fra', 'title', 'lmdz-t mesh fraction')
+
+   CALL fliodefv ( il_frac, 'aone.fra', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_frac, 'aone.fra', 'units'  , 'm^2' )
+   CALL flioputa ( il_frac, 'aone.fra', 'title', 'lmdz-t mesh fraction, set to 1')
+
+   CALL fliodefv ( il_frac, 'afra.fra', (/1, 2/), v_t=flio_r8 )
+   CALL flioputa ( il_frac, 'afra.fra', 'units'  , 'm^2' )
+   CALL flioputa ( il_frac, 'afra.fra', 'title', 'lmdz-t mesh fraction, set to 1')
+
+   CALL flioputv ( il_frac, 'tlmd.fra', xfra )
+   CALL flioputv ( il_frac, 'aone.fra', 1.0_rl + 0.0_rl*xfra )
+   CALL flioputv ( il_frac, 'afra.fra', xfra )
+
+   CALL flioclo ( il_frac)
+   
+   !
+   IF ( l_read ) THEN 
+      !! Sortie fichier bathy
+      OPEN ( unit = 27, file = 'bathy.lmdz', FORM = 'formatted', STATUS = 'unknown', ACTION = 'write', POSITION = 'rewind' )
+      DO jaj = jpaj, 1, -1
+         WRITE ( unit = 27, FMT = '(92I1)' )   INT ( xmas(:,jaj), KIND = i_4)
+      END DO
+      CLOSE ( unit = 27)
+      !! Sortie fichier bathy flux iceberg
+      flux_iceberg = 0.0
+      DO jai = 1, jpai
+         DO jaj = 1, jpaj
+            IF ( xmas(jai,jaj) == 0 ) THEN 
+               flux_iceberg(jai,jaj  ) = 2.0
+               flux_iceberg(jai,jaj+1) = 2.0
+               flux_iceberg(jai,jaj+2) = 1.0
+               flux_iceberg(jai,jaj+3) = 1.0
+               EXIT
+            END IF
+         END DO
+      END DO
+      !!
+      OPEN ( unit = 27, file = 'flux_iceberg', FORM = 'formatted', STATUS = 'unknown', ACTION = 'write', POSITION = 'rewind' )
+      DO jaj = jpaj, 1, -1
+         WRITE ( unit = 27, FMT = '(96F3.0)' )  flux_iceberg(:,jaj)
+      END DO
+   END IF
+   !!
+   STOP
+CONTAINS
+   ELEMENTAL FUNCTION clo_lon ( zlon, zlon0) ! Find closest longitude
+      IMPLICIT NONE
+      REAL (kind=rl) :: clo_lon
+      REAL (kind=rl), INTENT ( in) :: zlon, zlon0
+      REAL (kind=rl) :: zz, zp, zm, z0
+      INTEGER (kind=il) :: jn
+      z0 = zlon
+      DO jn = 1_il, 2_il
+         zz = ABS ( (z0           ) - zlon0 )
+         zp = ABS ( (z0 + 360.0_rl) - zlon0 )
+         zm = ABS ( (z0 - 360.0_rl) - zlon0 )
+         IF (      zp < MIN ( zm, zz) ) THEN 
+            z0 = z0 + 360.0_rl
+         ELSE IF ( zm < MIN ( zp, zz) ) THEN 
+            z0 = z0 - 360.0_rl
+         END IF
+      END DO
+      clo_lon = z0
+   END FUNCTION clo_lon
+
+   SUBROUTINE surface ( c_type )
+      IMPLICIT NONE
+      CHARACTER (len=*), OPTIONAL :: c_type
+      CHARACTER (len=8) :: cl_type
+      IF ( PRESENT (c_type)) THEN 
+         cl_type = TRIM (c_type)
+      ELSE
+         cl_type = 'globe'
+      END IF
+
+      IF ( TRIM(c_type) == 'globe') THEN 
+         WRITE (nout,*) 'Calcul des surfaces atm partout'
+         xare (:,:) = (xae(:,:)-xaw(:,:))*(yan(:,:)-yas(:,:)) * COS(rad*xlatt(:,:)) * rad * rad * ra * ra
+      END IF
+      
+      WRITE (nout,*) 'Calcul des surfaces atm aux poles'
+      xare (:, 1  ) = (xae(:,   1)-xaw(:,  1 ))*(1.0_rl - ABS(SIN(rad*yas(:,  1 )))) * rad * ra * ra
+      xare (:,jpaj) = (xae(:,jpaj)-xaw(:,jpaj))*(1.0_rl - ABS(SIN(rad*yan(:,jpaj)))) * rad * ra * ra
+
+   END SUBROUTINE surface
+
+   SUBROUTINE lmd1d_2d ( ztab1, ztab2 )
+      REAL (kind=rl), INTENT (in) , DIMENSION (:)   :: ztab1
+      REAL (kind=rl), INTENT (out), DIMENSION (:,:) :: ztab2
+      INTEGER :: jn, jn_min, jn_max
+
+      jn_min =  9999999
+      jn_max = -9999999
+
+      ztab2 ( :,  1  ) = ztab1 ( 1)
+      ztab2 ( :, jpai) = ztab1 ( nlmd)
+      
+      DO jaj = 2, jpai-1
+         DO jai = 1, jpai
+            jn = 1 + (jaj-2)*jpai + jai
+            jn_min = MIN ( jn, jn_min ) 
+            jn_max = MIN ( jn, jn_max ) 
+            ztab2 (jai, jaj) = ztab1 ( jn )
+         END DO
+      END DO
+      WRITE (nout,*) 'lmd1d_2d : ', jn_min, jn_max
+   END SUBROUTINE lmd1d_2d
+            
+END PROGRAM lmdgrille
Index: /TOOLS/MOZAIC/src/MOZAIC/locio.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/locio.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/locio.f90	(revision 3326)
@@ -0,0 +1,170 @@
+! -*- Mode: f90 -*-
+MODULE mod_locio
+ !> Read operations on fortran binary files, oasis format
+CONTAINS
+   SUBROUTINE locread (cdfldn, pfield, kdimax, knulre, kflgre, kout)
+      !> Read real in fortran binary files, oasis format
+      !
+      !     Purpose:
+      !     -------
+      !     Find string cdfldn on unit knulre and read array pfield
+      !
+      !     Reference:
+      !     ---------
+      !     See OASIS manual (1995) 
+      !
+      !     History:
+      !     -------
+      !       Version   Programmer     Date      Description
+      !       -------   ----------     ----      -----------  
+      !       2.0       L. Terray      95/09/01  created
+      !
+      ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      !
+      USE declare 
+      !!
+      IMPLICIT NONE
+      !
+      CHARACTER (len = 8), INTENT ( in) :: cdfldn ! Name of field to search for
+      INTEGER (kind=il), INTENT (  in) :: kdimax, knulre    ! Field dimension, unit to read
+      INTEGER (kind=il), INTENT (  in) :: kout              ! Standard output
+      INTEGER (kind=il), INTENT ( out) :: kflgre            ! Error status code
+      REAL (kind=rl)  , INTENT ( out), DIMENSION ( :) :: pfield ! Field
+      REAL (kind=rk_in), DIMENSION ( :), ALLOCATABLE :: ztemp
+      INTEGER (kind=il) :: ki
+      !
+      CHARACTER (len = 8) clecfl
+      INTEGER (kind=il) :: kerr
+      !
+      !*    1. Initialization
+      !        --------------
+      !
+      WRITE (UNIT = kout, FMT = '( " Locrint :  Read field ", A8, " in unit = ", 1I3, " Dim : ", 1I8)' ) cdfldn, knulre, kdimax
+      kerr = 0 ; ki = -1
+      !
+      !     2. Find field in file
+      !        ------------------
+      IF ( ALLOCATED (ztemp)) DEALLOCATE ( ztemp)
+      ALLOCATE (ztemp ( 1: kdimax), STAT = kerr )
+      IF ( kerr /= 0 ) THEN 
+         WRITE ( kout, *) 'Error allocating ztemp in locread : ', kerr
+         kflgre = kerr
+         RETURN
+      END IF
+      !
+      REWIND ( UNIT = knulre)
+200   CONTINUE
+      !* Find string
+      READ (UNIT = knulre, ERR = 200, END = 210) clecfl
+      IF ( clecfl /= cdfldn ) GO TO  200
+      !* Read associated field
+      WRITE ( unit = kout, fmt = *) 'Field found : ', clecfl
+      !$$$    READ (UNIT = knulre, IOSTAT = kerr, ERR = 210, END = 210 ) ztemp (1: kdimax)
+      !$$$    READ (UNIT = knulre, ERR = 210, END = 210 ) ztemp (1: kdimax)
+      ki = -2
+      READ (UNIT = knulre, ERR = 210, END = 210 ) (ztemp (ki), ki = 1, kdimax)
+      IF ( kerr == 0 ) THEN 
+         !* Reading done and ok
+         pfield (1: kdimax) = REAL ( ztemp (1: kdimax), KIND = rl )
+         kflgre = 0
+      ELSE 
+         WRITE ( unit = kout, fmt = *) 'Problem reading field ', cdfldn, kdimax, ki
+         kflgre = 1
+      END IF
+      GO TO 220
+      !* Problem in reading
+210   kflgre = 1
+      WRITE ( unit = kout, fmt = *) 'Problem in reading ', cdfldn, kdimax, ki
+220   CONTINUE
+      !
+      DEALLOCATE ( ztemp)
+      !
+      !*    3. End of routine
+      !        --------------
+      !
+      RETURN
+   END SUBROUTINE locread
+  !
+   SUBROUTINE locrint ( cdfldn, kfield, kdimax, knulre, kflgre, kout)
+      !> Read integer field in fortran binary files, oasis format
+      !
+      !     Purpose:
+      !     -------
+      !     Find string cdfldn on unit knulre and read integer array pfield
+      !
+      !     Reference:
+      !     ---------
+      !     See OASIS manual (1995) 
+      !
+      !     History:
+      !     -------
+      !       Version   Programmer     Date      Description
+      !       -------   ----------     ----      -----------  
+      !       2.0       L. Terray      95/09/01  created
+      !
+      ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      !
+      USE declare
+      !!
+      IMPLICIT none
+      !
+      CHARACTER (LEN = 8), INTENT (in) :: cdfldn ! Name of field to search for
+      INTEGER (kind=il), INTENT ( in) :: kdimax, knulre    ! Field dimension, unit to read
+      INTEGER (kind=il), INTENT ( in) :: kout              ! Standard output
+      INTEGER (kind=il), INTENT (out) :: kflgre            ! Error status code
+      INTEGER (kind=il), INTENT (inout), DIMENSION (:) :: kfield ! Field
+      INTEGER (kind=ik_in), DIMENSION ( :), ALLOCATABLE :: itemp
+      INTEGER (kind=il) :: ji
+      !
+      CHARACTER (len = 8) :: clecfl
+      INTEGER (kind=il) :: kerr
+      !
+      !*    1. Initialization
+      !        --------------
+      !
+      WRITE (UNIT = kout, FMT = '( " Locrint :  Read field ", A8, " in unit = ", 1I3, " Dim : ", 1I8)' ) cdfldn, knulre, kdimax
+      !
+      !     2. Find field in file
+      !        ------------------
+      IF ( ALLOCATED ( itemp)) DEALLOCATE ( itemp)
+      ALLOCATE ( itemp ( 1: kdimax), STAT = kerr )
+      IF ( kerr /= 0 ) THEN 
+         WRITE ( kout, *) 'Error allocating itemp in locrint : ', kerr
+         kflgre = kerr
+         RETURN
+      END IF
+      !
+      REWIND ( UNIT = knulre )
+200   CONTINUE
+      !
+      !* Find string
+      READ (UNIT = knulre, ERR = 200, END = 210) clecfl
+      IF ( clecfl /= cdfldn ) GO TO  200
+      !* Read associated field
+      WRITE (UNIT = kout, FMT= *)  clecfl, ' found'
+      !$$$    READ (UNIT = knulre, END = 210, IOSTAT = kerr) (itemp (ji), ji = 1, kdimax)
+      READ (UNIT = knulre, END = 210) (itemp (ji), ji = 1, kdimax)
+      IF ( kerr == 0 ) THEN 
+         !* Reading done and ok
+         kfield (1: kdimax) = INT ( itemp (1: kdimax), KIND = il)
+         kflgre = 0
+      ELSE 
+         WRITE ( unit = kout, fmt = *) 'Problem reading field ', cdfldn, kdimax, ji
+         kflgre = 1
+      END IF
+      GO TO 220
+      !* Problem in reading
+210   kflgre = 1
+      WRITE ( unit = kout, fmt = *) 'Problem in reading ', cdfldn, kdimax, ji
+      !
+220   CONTINUE
+      !
+      DEALLOCATE ( itemp)
+      !
+      !*    3. End of routine
+      !        --------------
+      !
+      RETURN
+   END SUBROUTINE locrint
+  !!
+END MODULE mod_locio
Index: /TOOLS/MOZAIC/src/MOZAIC/math.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/math.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/math.f90	(revision 3326)
@@ -0,0 +1,219 @@
+! -*- Mode: f90 -*-
+MODULE math
+   !
+   !> Some useful mathematical functions
+   !
+   USE declare
+   IMPLICIT NONE
+   !
+   !> 2D vector type, quadruple precision
+   TYPE v2d
+      REAL (kind=rd) :: x !< X-coordinate
+      REAL (kind=rd) :: y !< Y-coordinates
+   END TYPE v2d
+   !
+   !> Multiply 2D vectors
+   INTERFACE OPERATOR ( * )  
+      MODULE PROCEDURE vect_prod
+   END INTERFACE
+   !
+CONTAINS
+   !
+   ELEMENTAL FUNCTION vect_prod (a, b) 
+      !> Vector product
+      USE declare
+      IMPLICIT NONE
+      !
+      REAL (kind=rl) :: vect_prod
+      TYPE(v2d), INTENT (in) :: a !< First vector to multiply 
+      TYPE(v2d), INTENT (in) :: b !< 2nd vector to multiply
+      !
+      vect_prod = a%x * b%y - a%y * b%x
+      !
+      RETURN
+   END FUNCTION vect_prod
+   !
+   FUNCTION poly_surf (xa, ya )
+      !> Surface of a polygone
+      USE declare
+      IMPLICIT NONE
+      !
+      REAL (kind=rl) :: poly_surf
+      REAL (kind=rl), INTENT (in), DIMENSION ( :) :: xa, ya
+      INTEGER (kind=il) :: jn
+      REAL (kind=rd) :: zs
+      !
+      zs = 0.0_rd
+      DO jn = 1, SIZE (xa) - 2
+         zs = zs + v2d ( xa(jn+1)-xa(jn), ya(jn+1)-ya(jn)) * v2d ( xa(jn+2)-xa(jn), ya(jn+2)-ya(jn))
+      END DO
+      poly_surf = 0.5_rl * zs    
+      !
+      RETURN
+   END FUNCTION poly_surf
+   !
+   ELEMENTAL FUNCTION dist (x1, y1, x2, y2)
+      !> Distance between two points (cartesian)
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rl) :: dist
+      REAL (kind=rl), INTENT ( in) :: x1, y1, x2, y2
+      dist = SQRT ( (x2-x1)**2 + (y2-y1)**2 )
+      RETURN
+   END FUNCTION dist
+   ELEMENTAL FUNCTION ddist (x1, y1, x2, y2)
+      !> Distance between two points (cartesian), quadruple precision
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rd) :: ddist
+      REAL (kind=rd), INTENT ( in) :: x1, y1, x2, y2
+      ddist = SQRT ( (x2-x1)**2 + (y2-y1)**2 )
+      RETURN
+   END FUNCTION ddist
+   !
+   ELEMENTAL FUNCTION dgeodist (x1, y1, x2, y2)
+      !> Distance between two points (on sphere), quadruple precision
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rd) :: dgeodist
+      REAL (kind=rd), INTENT (in) :: x1, y1, x2, y2
+      REAL (kind=rd) :: zs, zrad
+      zrad = ACOS ( -1.0_rd) / 180.0_rd
+      zs =     SIN (zrad*REAL(y1,rd)) * SIN (zrad*REAL(y2,rd)) &
+         &  +  COS (zrad*REAL(y1,rd)) * COS (zrad*REAL(y2,rd)) * COS(zrad*REAL (x2-x1,rd))
+      zs = MAX (-1.0_rd, MIN (1.0_rd, zs))
+      dgeodist =  REAL ( ACOS (zs), KIND=rl)
+      RETURN
+   END FUNCTION dgeodist
+   !
+!-$$   ELEMENTAL FUNCTION geodist (x1, y1, x2, y2)
+!-$$      !> Distance between two points (on sphere)
+!-$$      USE declare
+!-$$      IMPLICIT NONE
+!-$$      REAL (kind=rl) :: geodist
+!-$$      REAL (kind=rl), INTENT (in) :: x1, y1, x2, y2
+!-$$      geodist = REAL (dgeodist (REAL (x1,rd), REAL (y1,rd), REAL (x2,rd), REAL(y2,rd)),rl)
+!-$$   END FUNCTION geodist
+
+   ELEMENTAL FUNCTION geodist (zlon1, zlat1, zlon2, zlat2)
+      !> Distance between two points (on sphere)
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rl) :: geodist
+      REAL (kind=rl), INTENT (in) :: zlon1, zlat1, zlon2, zlat2
+      REAL (kind=rl) :: zs, zrad
+      zrad = ACOS ( -1.0_rl) / 180.0_rl
+      zs = SIN (zrad*zlat1) * SIN (zrad*zlat2) +  COS (zrad*zlat1) * COS (zrad*zlat2) * COS(zrad*(zlon2-zlon1))
+      zs = MAX (-1.0_rl, MIN (1.0_rl, zs))
+      geodist =  ACOS (zs)
+      RETURN
+   END FUNCTION geodist
+
+!-$$   ELEMENTAL FUNCTION geodist_min (zlon1, zlat1, zlon2, zlat2, zdmax)
+!-$$      !> Distance between two points (on sphere). Simplified for too far points
+!-$$      USE declare
+!-$$      IMPLICIT NONE
+!-$$      REAL (kind=rl) :: geodist
+!-$$      REAL (kind=rl), INTENT (in) :: zlon1, zlat1, zlon2, zlat2, zdmax
+!-$$      REAL (kind=rl) :: zs, zrad
+!-$$
+!-$$      IF ( ABS (zlat2-zlat1)  .GT. zdmax * zrad ) THEN
+!-$$         geodist = zdmax
+!-$$         RETURN
+!-$$      END IF
+!-$$      
+!-$$      
+!-$$      zrad = ACOS ( -1.0_rl) / 180.0_rl
+!-$$      zs = SIN (zrad*zlat1) * SIN (zrad*zlat2) +  COS (zrad*zlat1) * COS (zrad*zlat2) * COS(zrad*(zlon2-zlon1))
+!-$$      zs = MAX (-1.0_rl, MIN (1.0_rl, zs))
+!-$$      geodist =  ACOS (zs)
+!-$$      RETURN
+!-$$   END FUNCTION geodist_min
+   
+   !
+   FUNCTION cartdist (zlon1, zlat1, zlon2, zlat2)
+      !> Distance between two points (on sphere)
+      ! Simplified computation
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rl) :: cartdist
+      REAL (kind=rl), INTENT (in) :: zlon1, zlat1, zlon2, zlat2
+      REAL (kind=rl) :: x1, y1, z1, x2, y2, z2, c1, c2, dx, dy, dz, dxyz
+      REAL (kind=rl) :: zrad
+      zrad = ACOS ( -1.0_rl) / 180.0_rl
+      c1   = COS(zrad*zlat1)
+      x1   = c1*COS(zrad*zlon1)
+      y1   = c1*SIN(zrad*zlon1)
+      z1   = SIN(zrad*zlat1)
+      c2   = COS(zrad*zlat2) 
+      x2   = c2*COS(zrad*zlon2)
+      y2   = c2*SIN(zrad*zlon2)
+      z2   = SIN(zrad*zlat2)
+      
+      dx = x1-x1 ; dy = y1-y2 ; dz = z1-z2
+      dxyz = dx*dx + dy*dy + dz*dz
+      cartdist = SQRT ( dxyz )
+
+   END FUNCTION cartdist
+   !
+   ELEMENTAL FUNCTION an_som (x0, y0, x1, y1, x2, y2)
+      !> Angle au sommet d'un triangle spherique
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rd) :: an_som
+      REAL (kind=rd), INTENT ( in) :: x0, y0, x1, y1, x2, y2
+      REAL (kind=rd) :: za, zb, zc, zs
+      za = dgeodist (REAL(x1,rd), REAL(y1,rd), REAL(x2,rd), REAL(y2,rd))
+      zb = dgeodist (REAL(x0,rd), REAL(y0,rd), REAL(x1,rd), REAL(y1,rd))
+      zc = dgeodist (REAL(x0,rd), REAL(y0,rd), REAL(x2,rd), REAL(y2,rd))
+      IF ( za == 0.0_rd .OR. zb == 0.0_rd .OR. zc == 0.0_rd ) THEN 
+         an_som = 0.0_rd
+      ELSE
+         zs =  ( COS(za)-COS(zb)*COS(zc) ) / ( SIN(zb)*SIN(zc) )
+         an_som = REAL (ACOS (zs))
+      ENDIF
+      RETURN
+   END FUNCTION an_som
+   !
+   ELEMENTAL FUNCTION surf_sphe (x1, y1, x2, y2, x3, y3)  
+      !> Surface d'un triangle spherique
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rd) :: surf_sphe
+      REAL (kind=rd), INTENT ( in) :: x1, y1, x2, y2, x3, y3
+      REAL (kind=rd) :: za, zb, zc
+      za = an_som (REAL(x1,rd), REAL(y1,rd), REAL(x3,rd), REAL(y3,rd), REAL(x2,rd), REAL(y2,rd))
+      zb = an_som (REAL(x2,rd), REAL(y2,rd), REAL(x1,rd), REAL(y1,rd), REAL(x3,rd), REAL(y3,rd))
+      zc = an_som (REAL(x3,rd), REAL(y3,rd), REAL(x2,rd), REAL(y2,rd), REAL(x1,rd), REAL(y1,rd))
+      IF ( za == 0.0_rd .OR. zb == 0.0_rd .OR. zc == 0.0_rd ) THEN 
+         surf_sphe = 0.0_rl
+      ELSE
+         surf_sphe = za + zb + zc - ACOS ( -1.0_rd)
+      ENDIF
+      RETURN
+   END FUNCTION surf_sphe
+   !
+   FUNCTION surf_box (xed, yed)
+      !> Surface d'une boite de modele
+      USE declare
+      IMPLICIT NONE
+      REAL (kind=rl) :: surf_box
+      REAL (kind=rl), DIMENSION(9), INTENT(in) :: xed, yed
+      INTEGER (kind=il) :: je, jne
+      REAL (kind=rd) :: zsurf
+
+      jne = SIZE(xed)
+      zsurf = 0.0_rl
+
+      DO je = 1, jne-1
+         zsurf = zsurf + surf_sphe (REAL(xed(jne ),rd), REAL(yed(jne ),rd), &
+            &                       REAL(xed(je  ),rd), REAL(yed(je  ),rd), &
+            &                       REAL(xed(je+1),rd), REAL(yed(je+1),rd) )
+      END DO
+
+      surf_box = REAL (zsurf, kind = rl)
+
+      RETURN
+   END FUNCTION surf_box
+   !
+END MODULE math
Index: /TOOLS/MOZAIC/src/MOZAIC/modeles.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/modeles.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/modeles.f90	(revision 3326)
@@ -0,0 +1,256 @@
+! -*- Mode: f90 -*-
+MODULE modeles
+   !> Declare tous les tableaux
+   !!
+   USE declare
+   USE dimensions
+   USE mod_prih
+   !!
+   IMPLICIT NONE
+   !!
+   SAVE 
+   PUBLIC 
+   !!
+   REAL (kind=rl), PARAMETER :: eps    = EPSILON (1.0_rl) !< Standard precision epsilon
+   REAL (kind=rl), PARAMETER :: eps10  = 10.0_rl * eps    !< Standard precision epsilon * 10
+   REAL (kind=rl), PARAMETER :: epsd   = EPSILON (1.0_rd) !< Quadruple precision epsilon
+   REAL (kind=rl), PARAMETER :: epsd10 = 10.0_rd * epsd   !< Quadruple precision epsilon * 10
+   REAL (kind=rl), PARAMETER :: epsfrac = 1.0E-10_rl  !< Min fraction of sea acceptable
+   !!
+   
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: yas, yan, xaw, xae      !< Limits of atmos box (south, north, west, east)
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: yos, yon, xow, xoe      !< Limits of atmos box (south, north, west, east)
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolont, xolatt, xosrft  !< Lon, lat and surface at T point for ocean
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolonu, xolatu, xosrfu  !< idem point u
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolonv, xolatv, xosrfv  !< idem point v
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xolonf, xolatf, xosrff  !< idem point f
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xalont, xalatt, xasrft  !< For atmosphere
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xalonu, xalatu, xasrfu
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xalonv, xalatv, xasrfv
+   REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xasrft_pol, xosrft_pol !< Surfaces calculées par les polygones.
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: nborda          !< 1 if atmosphere point is over some land point of ocean grid
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: nbordo          !< 1 if ocean point is over some land point of atmos grid 
+   REAL (kind=rl)   , DIMENSION (:,:), ALLOCATABLE :: wo2a      !< Weigts of interpolation ocean -> atmosphere
+   INTEGER(kind=il) , DIMENSION (:,:), ALLOCATABLE :: ko2a      !< Adresses ocean -> atmosphere
+   REAL (kind=rl)   , DIMENSION (:,:), ALLOCATABLE :: wa2o      !< Weights of interpolation atmosphere -> ocean
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: ka2o      ! Adresses atmosphere -> ocean
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: wasum !< Sum of weights of interpolation atmosphere -> ocean
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: wosum !< Sum of weights of interpolation ocean -> atmosphere
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: nva   !< Number of ocean neighbor for each atm point
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE  :: nvo   !< Number of atmos neighbor for each ocean point
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iomskt, iomsku, iomskv, iomskf !< Mask ocean model (sea=0, land=1)
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iamskt, iamsku, iamskv                !< Mask atm model   (sea=0, land=1)
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iamskp        !< Mask to remove redundant point by periodicity and north folding
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iomskp        !< Mask to remove redundant point by periodicity and north folding
+   REAL (kind=rl)   , DIMENSION (:, :), ALLOCATABLE  :: xo_ed !< Longitude of corner of oce boxes 
+   !< UL,UM,UR,MR,LR,LM,LL,ML.9 for middle of box
+   REAL (kind=rl)   , DIMENSION (:, :), ALLOCATABLE :: yo_ed !< Lat
+   REAL (kind=rl)   , DIMENSION (:, :), ALLOCATABLE :: xa_ed !< Atm
+   REAL (kind=rl)   , DIMENSION (:, :), ALLOCATABLE :: ya_ed
+   !!
+   CHARACTER (LEN=4) :: comod_a, comod_t, comod_u, comod_v, comod_f
+   CHARACTER (LEN=4) :: camod_a, camod_t, camod_u, camod_v, camod_f
+   !!
+   INTEGER (kind=il) :: maxo, maxa                         ! 
+   INTEGER (kind=il) :: nsum     !< Ponderation suivant le type de point trouve
+   !!
+   REAL (kind=rl) :: xinf, xsup                            !< Longitudes minimales et maximales de travail
+   INTEGER (kind=il) :: ngrd, nsrf, nmsk, nwei4o2a, nwei4a2o, nwei8o2a, nwei8a2o, nchk, ndeb, nbug1, nwei8, nwei4  !< IO unit numbers
+   !!
+   REAL (kind=rl) :: ra = 6371229.0_rl               !< Earth Radius (for OPA)
+   REAL (kind=rl) :: xsurfa, xsurfo                  !< Earth surface in each model
+   !!
+   CHARACTER (LEN = 8) :: cladress, clweight !< Name of OASIS weights/adresses
+
+   !
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: o2amask !< Ocean mask interpolated toward atmosphere
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: a2omask !< Atmosphere mask interpolated toward ocean
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: o2afull !< 1 on ocean interpolated toward atmosphere
+   REAL(kind=rl), DIMENSION (:), ALLOCATABLE :: a2ofull !< 1 on atmosphere interpolated toward ocean
+   !
+   INTEGER, DIMENSION (:), ALLOCATABLE :: o2amask_i_int !< Ocean mask interpolated toward atmosphere : full land only
+   INTEGER, DIMENSION (:), ALLOCATABLE :: o2amask_i_ext !< Ocean mask interpolated toward atmosphere : all points with some land
+   INTEGER, DIMENSION (:), ALLOCATABLE :: a2omask_i_int !< Atmosphere mask interpolated toward ocean : full land only
+   INTEGER, DIMENSION (:), ALLOCATABLE :: a2omask_i_ext !< Atmosphere mask interpolated toward ocean : all points with some land
+   !!
+   INTEGER (kind = il), DIMENSION (:), ALLOCATABLE :: m2ai, m2aj, m2oi, m2oj, moi, moj, mai, maj
+   INTEGER (kind = il), DIMENSION (:, :), ALLOCATABLE :: m1a, m1ar, m1o, m1or
+   !!
+CONTAINS
+   !!
+   SUBROUTINE alloc_modeles
+      !> Dimensionne tout les tableaux necessaires
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il) :: ja, jo, jai, jaj, joi, joj
+      INTEGER :: ierr
+      !!
+      WRITE (nout, *) 'Data types '
+      WRITE (nout, *) 'r_4 : ', r_4, 1.0_r_4, TINY(1.0_r_4), HUGE(1.0_r_4), EPSILON (1.0_r_4)
+      WRITE (nout, *) 'r_8 : ', r_8, 1.0_r_8, TINY(1.0_r_8), HUGE(1.0_r_8), EPSILON (1.0_r_8)
+      WRITE (nout, *) 'rd  : ', rd , 1.0_rd , TINY(1.0_rd) , HUGE(1.0_rd) , EPSILON (1.0_rd)
+      WRITE (nout, *) 'rl  : ', rl , 1.0_rl , TINY(1.0_rl) , HUGE(1.0_rl) , EPSILON (1.0_rl)
+      !!
+      ALLOCATE (yas    (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'yas', lreset = .TRUE., crout = 'common')
+      ALLOCATE (yan    (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'yan')
+      ALLOCATE (xaw    (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xaw')
+      ALLOCATE (xae    (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xae')
+
+      ALLOCATE (yos    (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'yos')
+      ALLOCATE (yon    (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'yon')
+      ALLOCATE (xow    (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xow')
+      ALLOCATE (xoe    (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xoe')
+      !
+      ALLOCATE (xolont (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolont')
+      ALLOCATE (xolonu (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolonu')
+      ALLOCATE (xolonv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolonv')
+      ALLOCATE (xolonf (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolonf')
+      ALLOCATE (xolatt (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatt')
+      ALLOCATE (xolatu (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatu')
+      ALLOCATE (xolatv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatv')
+      ALLOCATE (xolatf (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xolatf')
+      ALLOCATE (xosrft (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrft')
+      ALLOCATE (xosrfu (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrfu')
+      ALLOCATE (xosrfv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrfv')
+      ALLOCATE (xosrff (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrff')
+      !
+      ALLOCATE (xosrft_pol (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'xosrft_pol')
+      ALLOCATE (xasrft_pol (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xasrft_pol')
+      !
+      ALLOCATE (xalont (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalont')
+      ALLOCATE (xalonu (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalonu')
+      ALLOCATE (xalonv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'xalonv')
+      ALLOCATE (xalatt (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalatt')
+      ALLOCATE (xalatu (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xalatu')
+      ALLOCATE (xalatv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'xalatv')
+      ALLOCATE (xasrft (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xasrft')
+      ALLOCATE (xasrfu (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'xasrfu')
+      ALLOCATE (xasrfv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'xasrfv')
+      !
+      ALLOCATE (nborda (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'nborda')
+      ALLOCATE (nbordo (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'nbordo')
+      !
+      ALLOCATE (wo2a (jpo2a,jpan), STAT=ierr) ; CALL chk_allo (ierr, 'wo2a')
+      ALLOCATE (ko2a (jpo2a,jpan), STAT=ierr) ; CALL chk_allo (ierr, 'ko2a')
+      ALLOCATE (wa2o (jpa2o,jpon), STAT=ierr) ; CALL chk_allo (ierr, 'wa2o')
+      ALLOCATE (ka2o (jpa2o,jpon), STAT=ierr) ; CALL chk_allo (ierr, 'ka2o')
+
+      ALLOCATE (wasum (jpan)     , STAT=ierr) ; CALL chk_allo (ierr, 'wasum')
+      ALLOCATE (wosum (jpon)     , STAT=ierr) ; CALL chk_allo (ierr, 'wosum')
+      !
+      ALLOCATE (nvo (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'nvo')
+      ALLOCATE (nva (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'nva')
+      !
+      ALLOCATE (iomskt (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskt')
+      ALLOCATE (iomsku (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomsku')
+      ALLOCATE (iomskv (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskv')
+      ALLOCATE (iomskf (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskf')
+      ALLOCATE (iamskt (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'iamskt')
+      ALLOCATE (iamsku (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'iamsku')
+      ALLOCATE (iamskv (jpanv), STAT=ierr) ; CALL chk_allo (ierr, 'iamskv')
+      ALLOCATE (iomskp (jpon) , STAT=ierr) ; CALL chk_allo (ierr, 'iomskp')
+      ALLOCATE (iamskp (jpan) , STAT=ierr) ; CALL chk_allo (ierr, 'iamskp')
+      !
+      ALLOCATE (xo_ed (jpon, jpoe), STAT=ierr) ; CALL chk_allo (ierr, 'xo_ed')
+      ALLOCATE (yo_ed (jpon, jpoe), STAT=ierr) ; CALL chk_allo (ierr, 'yo_ed')
+      ALLOCATE (xa_ed (jpan, jpae), STAT=ierr) ; CALL chk_allo (ierr, 'xa_ed')
+      ALLOCATE (ya_ed (jpan, jpae), STAT=ierr) ; CALL chk_allo (ierr, 'ya_ed')
+      !
+      ALLOCATE (o2amask (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2amask')
+      ALLOCATE (a2omask (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2omask')
+      ALLOCATE (o2afull (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2afull')
+      ALLOCATE (a2ofull (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2ofull')
+      ALLOCATE (o2amask_i_int (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2amask_i_int')
+      ALLOCATE (o2amask_i_ext (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'o2amask_i_ext')
+      ALLOCATE (a2omask_i_int (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2omask_i_int')
+      ALLOCATE (a2omask_i_ext (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'a2omask_i_ext')
+      !
+      ! ----------------------------------------------------------------------------
+      ALLOCATE (m2ai (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'm2ai')
+      ALLOCATE (m2aj (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'm2aj')
+      ALLOCATE (mai  (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'mai ')
+      ALLOCATE (maj  (0:jpan), STAT=ierr) ; CALL chk_allo (ierr, 'maj ')
+      m2ai (0) = 0_il ; m2aj (0) = 0_il
+      DO ja = 1, jpan
+         jai = MOD (ja - 1_il, jpai) + 1_il
+         jaj = (ja - 1_il) / jpai + 1_il
+         m2ai (ja) = jai
+         m2aj (ja) = jaj
+         mai  (ja) = jai
+         maj  (ja) = MAX (1_il, MIN (jaj, jpaj))
+         IF (la_pole) THEN 
+            IF (jai ==  -1_il   ) mai (ja) = jpai-1_il
+            IF (jai ==   0_il   ) mai (ja) = jpai
+            IF (jai == jpai+1_il) mai (ja) = 1_il
+            IF (jai == jpai+2_il) mai (ja) = 2_il
+         END IF
+      END DO
+      ! ----------------------------------------------------------------------------
+      ALLOCATE (m2oi (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'm2oi')
+      ALLOCATE (m2oj (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'm2oj')
+      ALLOCATE (moi  (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'moi ')
+      ALLOCATE (moj  (0:jpon), STAT=ierr) ; CALL chk_allo (ierr, 'moj ')
+      m2oi (0) = 0_il ; m2oj (0) = 0_il
+      moi  (0) = 0_il ; moj  (0) = 0_il
+      DO jo = 1, jpon
+         joi = MOD (jo - 1_il, jpoi) + 1_il
+         joj = (jo - 1_il) / jpoi + 1_il
+         m2oi (jo) = joi
+         m2oj (jo) = joj
+         moi  (jo) = joi
+         moj  (jo) = MAX (1_il, MIN (joj, jpoj))
+         IF (noperio == 1 .OR. noperio == 4 .OR. noperio == -4_il) THEN 
+            IF (joi ==  -1_il   ) moi (jo) = jpoi-3_il
+            IF (joi ==   0_il   ) moi (jo) = jpoi-2_il
+            IF (joi ==   1_il   ) moi (jo) = jpoi-1_il
+            IF (joi == jpoi     ) moi (jo) = 2_il
+            IF (joi == jpoi+1_il) moi (jo) = 3_il
+            IF (joi == jpoi+2_il) moi (jo) = 4_il
+         ENDIF
+      END DO
+      ! ----------------------------------------------------------------------------
+      ALLOCATE (m1a  (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'm1a ')
+      ALLOCATE (m1ar (jpai, jpaj), STAT=ierr) ; CALL chk_allo (ierr, 'm1ar')
+      DO jaj = 1, jpaj
+         DO jai = 1, jpai
+            m1a (jai, jaj) = jai + (jaj - 1_il) * jpai
+         END DO
+      END DO
+      DO jaj = 1, jpaj
+         DO jai = 1, jpai
+            ja = m1a (jai, jaj)
+            m1a (jai, jaj) = m1a (mai (ja), maj (ja))
+         END DO
+      END DO
+      ! ----------------------------------------------------------------------------
+      ALLOCATE (m1o  (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'm1o ')
+      ALLOCATE (m1or (jpoi, jpoj), STAT=ierr) ; CALL chk_allo (ierr, 'm1or')
+      DO joj = 1, jpoj
+         DO joi = 1, jpoi
+            m1o  (joi, joj) = joi + (joj - 1_il) * jpoi
+         END DO
+      END DO
+      DO joj = 1, jpoj
+         DO joi = 1, jpoi
+            jo = m1o (joi, joj)
+            m1or (joi, joj) = m1o (moi (jo), moj (jo))
+         END DO
+      END DO
+      ! ----------------------------------------------------------------------------
+      
+!-$$      WRITE (nout,*) 'mai'
+!-$$      CALL prihin ( RESHAPE(mai (1:jpan), (/jpai, jpaj/)), kscale=3 )
+!-$$      WRITE (nout,*) 'maj'
+!-$$      CALL prihin ( RESHAPE(maj (1:jpan), (/jpai, jpaj/)), kscale=3 )
+!-$$      WRITE (nout,*) 'm2ai'
+!-$$      CALL prihin ( RESHAPE(m2ai(1:jpan), (/jpai, jpaj/)), kscale=3 )
+!-$$      WRITE (nout,*) 'm2aj'
+!-$$      CALL prihin ( RESHAPE(m2aj(1:jpan), (/jpai, jpaj/)), kscale=3 )
+!-$$      WRITE (nout,*) 'm1a'
+!-$$      CALL prihin (m1a , kscale=5)
+!-$$      WRITE (nout,*) 'm1ar'
+!-$$      CALL prihin (m1ar, kscale=5)
+!-$$      STOP
+
+   END SUBROUTINE alloc_modeles
+END MODULE modeles
Index: /TOOLS/MOZAIC/src/MOZAIC/mosaic.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/mosaic.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/mosaic.f90	(revision 3326)
@@ -0,0 +1,740 @@
+! -*- Mode: f90 -*-
+PROGRAM mosaic
+   ! -------------------------------------------------------------------------------
+   !
+   !> @brief Generates interpolation weights and adresses for Oasis Coupler, Mozaic interpolation
+   !
+   !>
+   !> Oceanic model : OPA (C Grid)
+   !> Atmospheric Model : LMD5, LMDz or spectral model with Gaussian grid
+   !>
+   !> -------------------------------------------------------------------------------
+   !>
+   !> http://www.ipsl.jussieu.fr/~omamce/IPSLCM4/MOZAIC
+   !>
+   !> -------------------------------------------------------------------------------
+   !>
+   !> Warning, to install, configure, run, use any of Olivier Marti's
+   !> software or to read the associated documentation you'll need at least
+   !> one (1) brain in a reasonably working order. Lack of this implement
+   !> will void any warranties (either express or implied). 
+   !> O. Marti assumes no responsability for errors, omissions,
+   !> data loss, or any other consequences caused directly or indirectly by
+   !> the usage of his software by incorrectly or partially configured
+   !> personal.
+   !>
+   !> 1) Read mask, grid and areas files, at OASIS format
+   !>     Convention for mask are those of Oasis : 0 for sea, 1 for land
+   !>
+   !> 2) Generates interpolation weights
+   !>
+   !> 3) Write them at Oasis format
+   !>
+   !> 4) Write some diagnostic fields in NetCDF format
+   !>
+   !>
+   !> @author Olivier MARTI, june 1996
+   !
+   !> Modification : Olivier MARTI, may 1997 : LMDZ case, from L. Li
+   !>                Eric GUILYARDI, may 1999 : Gaussian Grid + ORCA
+   !>                Olivier MARTI and Jacques BELLIER, april 2000 : use of polygon matching to compute weights
+   !>
+   ! --------------------------------------------------------------------------------
+   ! LSCE, CEA-Saclay
+   ! --------------------------------------------------------------------------------
+   !
+   !
+   USE modeles
+   USE mod_inipar
+   USE mod_locio
+   USE mod_neuf
+   USE bords
+   USE mod_lbc
+   USE mod_wripoly
+   USE mod_polyw_a
+   USE mod_polyw_o
+   USE formula
+   USE mod_lecdata
+   USE mod_prih
+   USE mod_norma
+   USE mod_rectifie
+   USE math
+   USE mod_inter
+   USE mod_wri_wei
+   USE fliocom
+   USE getincom
+   USE errioipsl
+   USE mod_polom
+   USE mod_proj
+   USE fliocom
+   !
+   IMPLICIT NONE
+   !
+   REAL (kind=rl) :: zzz
+   REAL (kind=rd) :: zs, zs1, zs2
+   INTEGER (kind=il) :: ja, jo, jai, jaj, joi, joj, jno, jna, kn ! Dummy indexes
+   INTEGER (kind=il), DIMENSION (2) :: jind
+   CHARACTER (len = 80) :: cfname4, cfname8
+   !
+   INTEGER, DIMENSION (:,:), ALLOCATABLE :: mt1, mt2, mt3
+   !
+   ! NetCDF
+   CHARACTER (len = 50) :: cldiag_o2a ! NetCDF file name for fields on atmospheric grid (diagnostics)
+   CHARACTER (len = 50) :: cldiag_a2o ! NetCDF file name for fields on oceanic grid  (diagnostics)
+   CHARACTER (len = 50) :: clw_o2a, clw_a2o, clw_a2o_mct, clw_o2a_mct
+   CHARACTER (len = 25) :: mo_name, o2a_name, a2o_name
+   CHARACTER (len =  1) :: c_i, c_r
+   INTEGER :: il_mask
+   CHARACTER (len=10) :: cmodel
+   !
+   REAL (kind=rd), DIMENSION (:), ALLOCATABLE :: xa, ya, xo, yo
+   INTEGER (kind=il) :: ierr
+   INTEGER (kind=il), DIMENSION (:,:), ALLOCATABLE :: itmp
+   CHARACTER (len=80) :: clarg
+   INTEGER :: narg
+   !>
+   !! Lecture de la ligne de comande
+   narg = iargc()
+   IF ( narg > 0 ) THEN
+      CALL getarg ( 1, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE Default
+         IF ( INDEX ( TRIM(clarg), '.def' ) /= 0 ) THEN
+            WRITE (nout,*) 'Lecture des parametres dans ', TRIM(clarg)
+            CALL getin_name ( TRIM (clarg) )
+         ELSE
+            WRITE (nout,*) 'Lecture des parametres dans run.def'
+         ENDIF
+      END SELECT
+   END IF
+   !
+   CALL inipar
+   CALL alloc_modeles
+   !
+   !> @par Initialisation
+   !
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13; nchk = 16 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 21 ; nwei8o2a = 22 ; nwei4a2o = 23 ; nwei8a2o = 24
+   ! Diagnostics files
+   !
+   nout = 6
+   IF (nout /= 6 .AND. nout /= 0) THEN 
+      OPEN (unit = nout, file = 'mosaic' // TRIM(c_suffix) // '.out', position = 'REWIND', action = 'WRITE', status = 'replace')
+   END IF
+   !>
+
+   WRITE (nout,*) 'm2ai ', MINVAL (m2ai), MAXVAL (m2ai)
+   WRITE (nout,*) 'm2aj ', MINVAL (m2aj), MAXVAL (m2aj) 
+   !
+   ndebug = 2
+   !
+   IF (lwra2o) THEN
+      WRITE (unit = nout, fmt = *) ' Compute weights and adresses for interpolation atm -> oce '
+   ELSE
+      WRITE (unit = nout, fmt = *) ' Nothing for atm -> oce '
+   ENDIF
+   IF (lwro2a) THEN
+      WRITE (unit = nout, fmt = *) ' Compute weights and adresses for interpolation oce -> atm '
+   ELSE
+      WRITE (unit = nout, fmt = *) ' Nothing for oce -> atm '
+   ENDIF
+   !
+   WRITE (nout,*) 'epsfrac : ', epsfrac
+   !
+   ka2o = 0 ; wa2o = 0.0_rl ; ko2a = 0 ; wo2a = 0.0_rl
+   !
+   !> Read coordinates of all models
+   !
+   IF (l_dryrun .AND. lev_dry >= 1 ) THEN 
+      CALL lecdata (lecweights = .TRUE. , leco2amask =.FALSE.)
+   ELSE
+      CALL lecdata (lecweights = .FALSE., leco2amask =.FALSE.)
+   ENDIF
+   !
+   !> Set periodicity
+   CALL lbc (xolont, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolonu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolonv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolonf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xolatt, noperio, 'T', jpoi, jpoj)
+   CALL lbc (xolatu, noperio, 'U', jpoi, jpoj)
+   CALL lbc (xolatv, noperio, 'V', jpoi, jpoj)
+   CALL lbc (xolatf, noperio, 'F', jpoi, jpoj)
+   CALL lbc (xosrft, noperio, 'T', jpoi, jpoj)
+   CALL lbc (iomskt, noperio, 'T', jpoi, jpoj)
+   !
+!-$$   CALL lbc (xalatt, naperio, 'T', jpai, jpaj)
+!-$$   CALL lbc (xalatu, naperio, 'U', jpai, jpaj)
+!-$$   CALL lbc (xalatv, naperio, 'V', jpai, jpaj)
+!-$$   CALL lbc (xasrft, naperio, 'T', jpai, jpaj)
+!-$$   CALL lbc (iamskt, naperio, 'T', jpai, jpaj)
+   !>
+   CALL rectifie
+   !>
+   CALL bord_a
+   !
+   CALL bord_o
+   !
+   CALL bord_oa
+   !
+   !> Surfaces par les polygones
+   ALLOCATE (xa (jpae), STAT=ierr) ; CALL chk_allo (ierr, 'xa in mosaic')
+   ALLOCATE (ya (jpae), STAT=ierr) ; CALL chk_allo (ierr, 'ya in mosaic')
+   !
+   IF (.NOT. l_dryrun .AND. l_recalc_a) THEN 
+      WRITE (nout,*) 'Recalcul les surfaces atm'
+      DO ja = 1, jpan
+         DO kn = 1, jpae
+            CALL proj (xa_ed (ja,kn), ya_ed (ja,kn), REAL(xa_ed(ja,jpae),rd), REAL(ya_ed(ja,jpae),rd), xa(kn), ya(kn), 2, ierr)
+         ENDDO
+         CALL polom (xa, ya, xa, ya, zs1, zs2, zs)
+         IF (MAX (zs1, zs2) .GT. MIN (zs1, zs2) + zeps .OR. ABS(zs-1.0_rl) > zeps) THEN 
+            WRITE (nout,*) 'pb surface atm : ', ja, mai(ja), maj(ja), zs1, zs2, zs
+         ELSE
+            xasrft_pol (ja) = zs1
+         END IF
+      END DO
+   END IF
+   !
+   WRITE (nout,*) 'Perio sur atm'
+   CALL lbc (xasrft_pol, naperio, 'T', jpai, jpaj)
+   !
+   WRITE (nout, *) 'Points T Atmosphere'
+   WRITE (nout, *) ' Longitude Atm '
+   WRITE (nout, '(10F7.1)') (xalont(m1a(jai,jpaj/2)),jai=1,jpai)    ! xalont (jpan/2+1:jpan/2+jpai)
+   WRITE (nout, *) ' Latitude Atm '
+   WRITE (nout, '(10F7.1)') (xalatt(m1a(jpai/2,jaj)),jaj=1,jpaj)    ! xalatt (1:jpan:jpai)
+   WRITE (nout, *) 'surface Atm'
+   CALL prihre(RESHAPE(xasrft,(/jpai,jpaj/)), 0.0_rl, nout)!-$$   WRITE (nout, *) 'Points east Atm'
+
+   WRITE (nout, *) 'Mask Atm'
+   DO jaj = jpaj, 1, -1
+      WRITE (nout, '(144I1)' ) (iamskt (m1a (jai, jaj)), jai = 1, jpai)
+   END DO
+   WRITE (nout, *) 'Mask Atm perio'
+   DO jaj = jpaj, 1, -1
+      WRITE (nout, '(144I1)' ) (iamskp (m1a (jai, jaj)), jai = 1, jpai)
+   END DO
+   WRITE (nout, *) 'Mask Oce'
+   DO joj = jpoj, 1, -1
+      WRITE (nout, '(1I5, "  ", 182I1)') joj, (iomskt (m1o (joi, joj)), joi = 1, jpoi    )
+   END DO
+   WRITE (nout, '(1I5, 18I10)')    joj, ( joi                   , joi = 1, jpoi, 10)
+   WRITE (nout, *) 'Mask Oce Perio'
+   DO joj = jpoj, 1, -1
+      WRITE (nout, '(1I5, "  ", 182I1)') joj, (iomskp (m1o (joi, joj)), joi = 1, jpoi    )
+   END DO
+   WRITE (nout, '(1I5, 18I10)')    joj, ( joi                   , joi = 1, jpoi, 10)
+
+   !
+   ALLOCATE (xo (jpoe), STAT=ierr) ; CALL chk_allo (ierr, 'xo in mosaic')
+   ALLOCATE (yo (jpoe), STAT=ierr) ; CALL chk_allo (ierr, 'yo in mosaic')
+   !
+   IF (.NOT. l_dryrun .AND. l_recalc_o) THEN
+      WRITE (nout,*) 'Recalcul des surfaces oce'
+      ReOce: DO jo = 1, jpon
+         IF ( iomskp(jo) == 0 .AND. iomskt(jo) == 0 ) THEN 
+            ! WRITE (nout,*) jo, xo_ed (jo,jpoe), yo_ed (jo,jpoe)
+            DO kn = 1, jpoe
+               CALL proj (xo_ed (jo,kn), yo_ed (jo,kn), REAL(xo_ed(jo,jpoe),rd), REAL(yo_ed(jo,jpoe),rd), xo(kn), yo(kn), 2, ierr)
+            ENDDO
+            CALL polom (xo, yo, xo, yo, zs1, zs2, zs)
+            IF (MAX (zs1, zs2) .GT. MIN (zs1, zs2) + zeps ) THEN 
+               WRITE (nout,*) 'pb 1 surface oce : ', jo, iomskp(jo), iomskt(jo), m2oi(jo), m2oj(jo), &
+                  & xolont(jo), xolatt(jo), zs1, zs2, ABS(zs1-zs2), ABS(zs1-zs2)/MAX(zs1,zs2),zs, zs-1.0_rl
+            END IF
+            IF (ABS(zs-1.0_rl) > zeps) THEN 
+               WRITE (nout,*) 'pb 2 surface oce : ', jo, iomskp(jo), iomskt(jo), m2oi(jo), m2oj(jo), &
+                  & xolont(jo), xolatt(jo), zs1, zs2, ABS(zs1-zs2), ABS(zs1-zs2)/MAX(zs1,zs2),zs, zs-1.0_rl
+            END IF
+            xosrft_pol (jo) = zs1
+         END IF
+      END DO ReOce
+   END IF
+!-$$   xosrft_pol = xosrft
+   
+   CALL lbc (xosrft_pol, noperio, 'T', jpoi, jpoj)
+   !
+   WRITE (nout, *) 'Points T Ocean'
+   WRITE (nout, *) ' Longitudes Oce '
+   WRITE (nout, '(10F7.1)') xo_ed (1: jpoi, jpoe)
+   DO jno = 1, jpoe-1
+      WRITE (nout, *) 'Longitudes points Oce ', jno
+      WRITE (nout, '(10F7.1)') xo_ed (1: jpoi, jno)
+      WRITE (nout, *) 'Latitudes points Oce ', jno
+      WRITE (nout, '(10F7.1)') yo_ed (1: jpon: jpoj, jno)
+   ENDDO
+   !
+   DO jna = 1, jpae-1
+      WRITE (nout, *) 'Longitudes points Atm ', jna
+      WRITE (nout, '(10F7.1)') xa_ed (1: jpai, jna)
+      WRITE (nout, *) 'Latitudes points Atm ', jna
+      WRITE (nout, '(10F7.1)') ya_ed (1: jpan: jpaj, jna)
+   ENDDO
+   !
+   WRITE (nout,*) 'total surface oce ', SUM(xosrft*REAL(1-iomskp,rl))
+   WRITE (nout,*) 'total surface atm ', SUM(xasrft*REAL(1-iamskp,rl))
+   !
+   IF (l_dryrun) THEN
+      SELECT CASE (lev_dry)
+      CASE (0)
+         WRITE (nout,*) "Remplissage bidon des champs pour tester les I/O"
+!-$$         jma2o = jpa2o ; jmo2a = jpo2a
+         nvo = jma2o   ; nva   = jmo2a
+         CALL RANDOM_SEED
+         CALL RANDOM_NUMBER (wa2o)
+         CALL RANDOM_NUMBER (wo2a)
+         
+         WRITE (nout,*) 'wa2o : ', MINVAL (wa2o), MAXVAL (wa2o)
+         WRITE (nout,*) 'wo2a : ', MINVAL (wo2a), MAXVAL (wo2a)
+         
+         ka2o (:,:) = NINT ( wa2o(:,:) * REAL(jpan,rl) )
+         ko2a (:,:) = NINT ( wo2a(:,:) * REAL(jpon,rl) )
+
+         WRITE (nout,*) 'ka2o : ', MINVAL (ka2o), MAXVAL (ka2o)
+         WRITE (nout,*) 'ko2a : ', MINVAL (ko2a), MAXVAL (ko2a)
+
+         wa2o(:,:) = ( 0.5 + wa2o(:,:) ) / REAL ( jma2o, KIND=rl)
+         wo2a(:,:) = ( 0.5 + wo2a(:,:) ) / REAL ( jmo2a, KIND=rl)
+
+         WRITE (nout,*) 'wa2o : ', MINVAL (wa2o), MAXVAL (wa2o)
+         WRITE (nout,*) 'wo2a : ', MINVAL (wo2a), MAXVAL (wo2a)
+
+         !! Masquage
+         DO ja = 1, jpan
+            IF ( iamskt (ja) == 1 ) THEN 
+               wo2a (:, ja) = 0.0_rl ; ko2a (:, ja) = 0_il
+            END IF
+         END DO
+         DO jo = 1, jpon
+            IF ( iomskt (jo) == 1 ) THEN
+               wa2o (:, jo) = 0.0_rl ; ka2o (:, jo) = 0_il
+            END IF
+         END DO
+
+         DO ja = 1, jpan
+            DO jna = 1, jpo2a
+               jo = ko2a (jna, ja)
+               IF (jo > 0) THEN 
+                  IF (iomskt (jo) == 1) THEN
+                     wo2a (jna, ja) = 0.0_rl ; ko2a (jna, ja) = 0_il
+                  END IF
+               END IF
+            END DO
+         END DO
+
+         DO jo = 1, jpon
+            DO jno = 1, jpa2o
+               ja = ka2o (jno, jo)
+               IF (ja > 0) THEN 
+                  IF (iamskt (ja) == 1) THEN
+                     wa2o (jno, jo) = 0.0_rl ; ka2o (jno, jo) = 0_il
+                  END IF
+               END IF
+            END DO
+         END DO
+         !! Normalisation
+         DO jo = 1, jpon
+            wa2o(:,jo) = wa2o (:,jo) / SUM ( wa2o (:,jo))
+         END DO
+         DO ja = 1, jpan
+            wo2a(:,ja) = wo2a (:,ja) / SUM ( wo2a (:,ja))
+         END DO
+
+         CALL gather ('o2a')
+         !CALL inter_o2a (REAL (1-iomskt, KIND = rl), o2amask)
+         !CALL rem_small ('o2a')
+         CALL gather ('a2o')
+         
+         WRITE (nout,*) 'ka2o : ', MINVAL (ka2o), MAXVAL (ka2o)
+         WRITE (nout,*) 'ko2a : ', MINVAL (ko2a), MAXVAL (ko2a)
+         
+         WRITE (nout,*) 'wa2o : ', MINVAL (wa2o), MAXVAL (wa2o)
+         WRITE (nout,*) 'wo2a : ', MINVAL (wo2a), MAXVAL (wo2a)
+         
+      CASE (1)
+         WRITE (nout,*) "Utilisation des poids lus"
+      END SELECT
+   ELSE
+      WRITE (nout,*) 'Appel de polyw_a'
+      CALL polyw_a (lo2a = .TRUE., la2o = .TRUE.)
+      WRITE (nout,*) 'Appel de gather(o2a) apres polyw_a'
+      CALL gather ('o2a')
+      WRITE (nout,*) 'Appel de gather(a2o) apres polyw_a'
+      CALL gather ('a2o')
+   ENDIF
+   !
+      
+   !> Checking weights
+   WRITE (unit = nout, fmt = '("Neighbors o2a     : ", 3I12 )') MINVAL (nva, nva /=0), MAXVAL (nva), jmo2a
+   WRITE (unit = nout, fmt = '("Index o2a         : ", 2I12 )') MINVAL (ko2a, ko2a /= 0), MAXVAL (ko2a)
+   jind = MINLOC(wo2a, wo2a /= 0.0_rl) ; ja = jind(2) ; jna = jind(1); jai = m2ai(ja) ; jaj = m2aj(ja)
+   WRITE (unit = nout, fmt = '("Weights o2a mini : ", 2I8, 2I4, 1E13.4, 3I8)') &
+      & ja, jna, jai, jaj, wo2a(jna,ja), ko2a(jna,ja), m2oi(ko2a(jna,ja)), m2oj(ko2a(jna,ja))
+   jind = MAXLOC(wo2a, wo2a /= 0.0_rl) ; ja = jind(2) ; jna = jind(1); jai = m2ai(ja) ; jaj = m2aj(ja)
+   WRITE (unit = nout, fmt = '("Weights o2a maxi : ", 2I8, 2I4, 1E13.4, 3I8)') &
+      & ja, jna, jai, jaj, wo2a(jna,ja), ko2a(jna,ja), m2oi(ko2a(jna,ja)), m2oj(ko2a(jna,ja))
+   !> Ocean mask interpolated to atm
+   CALL inter_o2a (REAL (1-iomskt, KIND = rl), o2amask)
+!-$$   WRITE (nout,*) 'Ocean mask interpolated to atm before normalisation'
+!-$$   CALL prihre(RESHAPE(o2amask,(/jpai,jpaj/)),10.0_rl,INT(nout,kind=i_4))
+   !
+   !> Classes
+   WRITE (nout, *) 'Low sea fraction before normalization'
+   DO kn = 1, 16
+      zzz = 10.0_rl**(-kn)
+      WRITE (nout, *) 'Classe : ', kn, COUNT (o2amask .LE. zzz .AND. o2amask .GT. zzz/10.0_rl)
+   END DO
+   WRITE (nout, *) 'High sea fraction'
+   DO kn = 1, 16
+      zzz = 10.0_rl**(-kn)
+      WRITE (nout, *) 'Classe : ', kn, COUNT (1.0_rl-o2amask .LE. zzz .AND. 1.0_rl-o2amask .GT. zzz/10.0_rl)
+   END DO
+   !> Remove small fractions
+   CALL rem_small ('o2a')
+   !> Recalcule le masque. A faire avant la normalisation
+   CALL inter_o2a (REAL (1-iomskt, KIND = rl), o2amask)
+   ! Petit bug ...
+   !IF ( catyp == 'lmdz' ) o2amask (jpan-jpai+1:jpan) = 1.0_rl
+   !
+!-$$   WRITE (nout, *) 'ATM : Sea fraction < 0'
+!-$$   DO ja = 1, jpan
+!-$$      IF (o2amask (ja) < 0.0_rl) THEN 
+!-$$         WRITE (nout,*) ja, m2ai (ja), m2aj (ja), o2amask (ja)
+!-$$      ENDIF
+!-$$   ENDDO
+!-$$   WRITE (nout, *) 'ATM : Sea fraction > 1'
+!-$$   DO ja = 1, jpan
+!-$$      IF (o2amask (ja) > 1.0_rl+eps) THEN 
+!-$$         WRITE (nout,*) ja, m2ai (ja), m2aj (ja), o2amask (ja)
+!-$$      ENDIF
+!-$$   ENDDO
+
+   o2amask_i_int (:) = 1
+   o2amask_i_ext (:) = 1
+   WHERE ( o2amask (:) >  0.0_rl         ) o2amask_i_int = 0
+   WHERE ( o2amask (:) > 1.0_rl-epsfrac ) o2amask_i_ext = 0
+ 
+   !
+   WRITE (nout,*) 'Appel de gather a2o avant verif'
+   CALL gather ('a2o')
+   !
+   !> Checking weights
+   WRITE (unit = nout, fmt = '("Neighbors a2o     : ", 3I9 )') MINVAL (nvo, nvo /=0), MAXVAL (nvo), jma2o
+   WRITE (unit = nout, fmt = '("Index a2o         : ", 2I9 )') MINVAL (ka2o, ka2o /= 0), MAXVAL (ka2o)
+   jind = MINLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jno = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o mini : ", 2I8, 2I4, 1E13.4, 3I6)') &
+      & jo, jno, joi, joj, wa2o(jno,jo), ka2o(jno,jo), m2ai(ka2o(jno,jo)), m2aj(ka2o(jno,jo))
+   jind = MAXLOC(wa2o, wa2o /= 0.0_rl) ; jo = jind(2) ; jno = jind(1); joi = m2oi(jo) ; joj = m2oj(jo)
+   WRITE (unit = nout, fmt = '("Weights a2o maxi : ", 2I8, 2I4, 1E13.4, 3I6)') &
+      & jo, jno, joi, joj, wa2o(jno,jo), ka2o(jno,jo), m2ai(ka2o(jno,jo)), m2aj(ka2o(jno,jo))
+   !> Atm mask interpolated to oce
+   CALL inter_a2o (REAL (1-iamskt, KIND = rl), a2omask)
+   WRITE (nout,*) 'Atm mask interpolated to oce before normalization'
+   !$$$   CALL prihre(RESHAPE(a2omask,(/jpoi,jpoj/)),10.0_rl,INT(nout,kind=i_4))
+   !> Remove small fractions
+   CALL rem_small ('a2o')
+   CALL inter_a2o (REAL (1-iamskt, KIND = rl), a2omask)
+   !
+!-$$   WRITE (nout, *) 'OCE : Sea fraction < 0'
+!-$$   DO jo = 1, jpon
+!-$$      IF (a2omask(jo) < 0.0) THEN 
+!-$$         WRITE (nout,*) jo, m2oi(jo), m2oj(jo), o2amask(jo)
+!-$$      ENDIF
+!-$$   ENDDO
+!-$$   WRITE (nout, *) 'OCE : Sea fraction > 1'
+!-$$   DO jo = 1, jpon
+!-$$      IF (a2omask(jo) > 1.0+eps) THEN 
+!-$$         WRITE (nout,*) jo, m2oi(jo), m2oj(jo), a2omask(jo)
+!-$$      ENDIF
+!-$$   ENDDO
+   ! Normalise
+   IF (TRIM (catyp) == 'lmdz' ) THEN 
+      WRITE (unit=nout, FMT=*) 'Calling normalization '
+      CALL norma (knorma2o = norma2o, knormo2a = normo2a)
+   END IF
+   !
+   WRITE (unit=nout,fmt='("Maxval de sum(wo2a)-1 ", 1E15.4)') MAXVAL (SUM (wo2a(:,:),DIM=1)) -1.0_rl
+   !
+   WRITE (unit = nout, fmt = '("Surface atmos               : ", 1PE15.4)') &
+      DOT_PRODUCT (xasrft, REAL(1-iamskp,kind=rl))
+   WRITE (unit = nout, fmt = '("Surface ocean               : ", 1PE15.4)') &
+      DOT_PRODUCT (xosrft, REAL(1-iomskp,kind=rl))
+   !
+   WRITE (unit = nout, fmt = '("Oce->Atm : ", 1I9, " non-null adresses, ", 1I12, " non-null weights ")') & 
+      & COUNT (wo2a > 0.0_rl), COUNT (ko2a > 0)
+   WRITE (unit = nout, fmt = '("Atm->Oce : ", 1I9, " non-null adresses, ", 1I12, " non-null weights ")') &
+      & COUNT (wa2o > 0.0_rl), COUNT (ka2o > 0)
+   !
+   xsurfa = DOT_PRODUCT (xasrft*REAL(1-iamskp,kind=rl), 1.0_rl - o2amask)
+   xsurfo = DOT_PRODUCT (xosrft, REAL((1-iomskt)*(1-iomskp), kind=rl))
+   WRITE (nout, fmt= '("Ocean surface on ocean and atmosphere : ", 2(1PE20.6))') xsurfo, xsurfa
+   !
+   !> Write Weights for OASIS
+   !
+   mo_name = 'mozaic'
+   o2a_name = "o2a" ; a2o_name = "a2o"
+   WRITE (unit = c_r, fmt = '(1i1)') rk_out
+   IF (lwro2a) THEN 
+      IF (l_wei_i4) THEN 
+         WRITE (unit = c_i, fmt = '(1i1)') i_4
+         cfname4 = TRIM(mo_name) // ".wo2a"  // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r) 
+         WRITE (nout, *) 'Poids i4 o -> a: ', TRIM(cfname4)
+         OPEN (unit = nwei4o2a, file = TRIM(cfname4), form = 'unformatted', status = 'replace', action = 'write')
+      ENDIF
+      !
+      IF (l_wei_i8) THEN
+         WRITE (unit = c_i, fmt = '(1i1)') i_8
+         cfname8 = TRIM(mo_name) // ".wo2a" // TRIM(c_suffix) // ".i" // TRIM(c_i)  // ".r" // TRIM(c_r) 
+         WRITE (nout, *) 'Poids i8 : ', TRIM(cfname8)
+         OPEN (unit = nwei8o2a, file = TRIM(cfname8), form = 'unformatted', status = 'replace', action = 'write')
+      ENDIF
+      !
+      cldiag_o2a  = TRIM(o2a_name) // '.diag'
+      clw_o2a     = TRIM(mo_name)  // '.wo2a'
+      clw_o2a_mct = "rmp_"//TRIM(comod_t)//"_to_"//TRIM(camod_t)//"_MOSAIC"
+      CALL wri_weights_o2a (cldiag_o2a, clw_o2a, clw_o2a_mct, "1", l_fulldiag=.FALSE., &
+         & lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE.)
+      CLOSE (unit = nwei8o2a) ; CLOSE (unit = nwei4o2a)
+
+   ENDIF
+
+   IF (lwra2o) THEN 
+      !$$$      WRITE (nout,*) 'Ocean mask interpolated to atm, before writing'
+      !$$$      CALL prihre(RESHAPE(o2amask,(/jpai,jpaj/)),10.0_rl,INT(nout,kind=i_4))
+      IF (l_wei_i4) THEN
+         WRITE (unit = c_i, fmt = '(1i1)') i_4
+         cfname4 = TRIM(mo_name) // ".wa2o"  // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r)
+         WRITE (nout, *) 'Poids i4 a -> o: ', TRIM(cfname4)
+         OPEN (unit = nwei4a2o, file = TRIM(cfname4), form = 'unformatted', status = 'replace', action = 'write')
+      END IF
+
+      IF (l_wei_i8) THEN
+         WRITE (unit = c_i, fmt = '(1i1)') i_8
+         cfname8 = TRIM(mo_name) // ".wa2o" // TRIM(c_suffix) // ".i" // TRIM(c_i) // ".r" // TRIM(c_r) 
+         WRITE (nout, *) 'Poids i8 : ', TRIM(cfname8)
+         OPEN (unit = nwei8a2o, file = TRIM(cfname8), form = 'unformatted', status = 'replace', action = 'write')
+      ENDIF
+
+      cldiag_a2o  = TRIM(a2o_name) // '.diag'
+      clw_a2o     = TRIM(mo_name)  // '.wa2o'
+      clw_a2o_mct = "rmp_"//TRIM(camod_t)//"_to_"//TRIM(comod_t)//"_MOSAIC"
+      CALL wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, "2", l_fulldiag=.FALSE., &
+         & lo_src_grid_frac=.FALSE., lo_dst_grid_frac=.FALSE.)
+
+      IF (l_wei_i4) CLOSE (unit = nwei8a2o) 
+      IF (l_wei_i8) CLOSE (unit = nwei4a2o)
+
+   ENDIF
+
+   !$$$   IF (lwro2a) THEN 
+   !$$$      !> Compute o2a weights for interpolating fluxes
+   !$$$      !
+   !$$$      !
+   !$$$      !> Normalize weights
+   !$$$      WRITE (nout, *) 'Calling normalization '
+   !$$$      CALL norma (knorma2o = 0_il, knormo2a = 2_il)
+   !$$$      !
+   !$$$      WRITE (unit = cfname4, fmt = '("mozaic.wo2a.flx.i", 1I1, ".r", 1I1)') i_4, rk_out
+   !$$$      OPEN (unit = nwei4o2a, file = TRIM(cfname4), form = 'unformatted', status = 'replace', action = 'write')
+   !$$$      WRITE (nout, *) 'Poids i4 o -> a: ', TRIM(cfname4)
+   !$$$
+   !$$$      WRITE (unit = cfname8, fmt = '("mozaic.wo2a.flx.i", 1I1, ".r", 1I1)') i_8, rk_out
+   !$$$      OPEN (unit = nwei8o2a, file = TRIM(cfname8), form = 'unformatted', status = 'replace', action = 'write')
+   !$$$      WRITE (nout, *) 'Poids i8 : ', TRIM(cfname8)
+   !$$$
+   !$$$      cldiag_o2a = 'o2a_flx_diag' ; clw_o2a    = 'mozaic.wo2a.flx'
+   !$$$
+   !$$$      nwei4o2a = 56 ; nwei8o2a = 57
+   !$$$      CALL wri_weights_o2a (cldiag_o2a, clw_o2a, "6")
+   !$$$
+   !$$$      CLOSE (unit = nwei8o2a)
+   !$$$      CLOSE (unit = nwei4o2a)
+   !$$$
+   !$$$      !
+   !$$$   ENDIF
+   !
+   !
+   CALL flioclo
+   WRITE (unit = nout, fmt = *) 'That''s all folks ! '
+   !
+   STOP
+CONTAINS
+   !
+   SUBROUTINE perio_w (clname)
+      CHARACTER (len=*), INTENT (in) :: clname
+      !
+      SELECT CASE (TRIM(clname))
+      CASE ('a2o')
+         !> Periodicity ocean
+         jma2o = MAXVAL (nvo)
+         DO jno = 1, jma2o
+            CALL lbc (wa2o (jno,:) , noperio, 'T', jpoi, jpoj)
+            CALL lbc (ka2o (jno,:) , noperio, 'T', jpoi, jpoj)
+         END DO
+      CASE ('o2a')
+         !> Periodicity atm
+         jmo2a = MAXVAL (nva)
+         DO jna = 1, jmo2a
+            CALL lbc (wo2a (jna,:) , naperio, 'T', jpai, jpaj)
+            CALL lbc (ko2a (jna,:) , naperio, 'T', jpai, jpaj)
+         END DO
+         !
+      END SELECT
+   END SUBROUTINE perio_w
+   !
+   SUBROUTINE gather (clname)
+      !
+      CHARACTER (len=*), INTENT (in) :: clname
+      INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: ktemp
+      REAL    (kind=rl), DIMENSION (:), ALLOCATABLE :: wtemp
+      INTEGER (kind=il) :: ierr, jn, jon1, jon2, ja1, ja2
+      !
+     
+      !
+      SELECT CASE (TRIM(clname))
+      CASE ('o2a')
+         !
+         CALL perio_w (clname)
+         !
+         ALLOCATE (ktemp (jpo2a), STAT=ierr) ; CALL chk_allo (ierr, 'ktemp (jpo2a)', crout='mosaic, gather o2a')
+         ALLOCATE (wtemp (jpo2a), STAT=ierr) ; CALL chk_allo (ierr, 'wtemp (jpo2a)')
+         DO ja = 1, jpan
+            ktemp (:) = ko2a (:,ja) ; wtemp (:) = wo2a (:,ja)
+            ko2a (:,ja) = 0_il  ; wo2a (:,ja) = 0.0_rl
+            kn = 1
+            DO jna = 1, jmo2a
+               IF ( ktemp (jna) /= 0_il ) THEN
+                  ko2a (kn, ja) =  ktemp (jna)
+                  wo2a (kn, ja) =  wtemp (jna)
+                  kn = kn + 1
+               END IF
+            END DO
+         END DO
+         nva = COUNT (ko2a /= 0, DIM = 1)
+         IF ( MAXVAL (nva) > jmo2a ) THEN
+            WRITE (nout, FMT=*) 'Attention: augmentation de jmo2a dans gather o2a'
+            STOP
+         ELSE
+            jmo2a = MAXVAL (nva)
+         END IF
+         WRITE (unit = nout, fmt = *) 'Nombre de voisins o->a : ', jmo2a
+         DEALLOCATE (ktemp) ; DEALLOCATE(wtemp)
+         !
+      CASE ('a2o')
+         IF ( naperio == -1 ) THEN 
+            ! Pointage vers le point pole
+            DO jo = 1, jpon
+               DO jn = 1, jma2o
+                  IF ( m2aj (ka2o (jn, jo)) == 1    ) ka2o (jn, jo) = m1a ( 1,  1  )
+                  IF ( m2aj (ka2o (jn, jo)) == jpaj ) ka2o (jn, jo) = m1a ( 1, jpaj)
+               END DO
+            END DO
+         END IF
+         !
+         ! Si deux adresses identiques, simplification et somme des poids
+         DO jo = 1, jpon
+            DO jon1 = 1, jma2o
+               ja1 = ka2o (jon1, jo)
+               IF ( ja1 == 0 ) CYCLE
+               DO  jon2 = 1, jpa2o
+                  IF ( jon1 == jon2 ) CYCLE
+                  ja2 = ka2o (jon2, jo)
+                  IF ( ja1 == ja2 ) THEN
+                     wa2o (jon1, jo) = wa2o (jon1, jo) + wa2o (jon2, jo)
+                     wa2o (jon2, jo) = 0.0_rl
+                     ka2o (jon2, jo) = 0
+                  END IF
+               END DO
+            END DO
+         END DO
+         !
+         CALL perio_w (clname)      
+         !
+         ALLOCATE (ktemp (jpa2o), STAT=ierr) ; CALL chk_allo (ierr, 'ktemp (jpa2o)', crout='mosaic, gather a2o')
+         ALLOCATE (wtemp (jpa2o), STAT=ierr) ; CALL chk_allo (ierr, 'wtemp (jpa2o)')
+         DO jo = 1, jpon
+            ktemp = ka2o(:,jo) ; wtemp = wa2o(:,jo)
+            ka2o (:,jo) = 0_il  ; wa2o (:,jo) = 0.0_rl
+            kn = 1_il
+            DO jno = 1, jma2o
+               IF ( ktemp (jno) /= 0_il ) THEN
+                  ka2o (kn, jo) =  ktemp (jno)
+                  wa2o (kn, jo) =  wtemp (jno)
+                  kn = kn + 1_il
+               END IF
+            END DO
+         END DO
+         nvo = COUNT (ka2o /= 0, DIM = 1)
+         IF ( MAXVAL (nvo) > jma2o) THEN
+            WRITE (nout,*) 'Attention: augmentation de nvo dans gather'
+            STOP
+         ELSE
+            jma2o = MAXVAL (nvo)
+         ENDIF
+         WRITE (unit = nout, fmt = *) 'Nombre de voisins a->o : ', jma2o
+         DEALLOCATE (ktemp) ; DEALLOCATE (wtemp)
+         !
+      END SELECT
+
+      !
+   END SUBROUTINE gather
+   !
+!-$$   SUBROUTINE pole_a2o
+!-$$      !
+!-$$      IMPLICIT NONE
+!-$$      !
+!-$$      DO jn = 1, jma2o
+!-$$         DO jo = 
+!-$$         
+   !
+   SUBROUTINE rem_small (clname)
+      !
+      CHARACTER (len=*), INTENT (in) :: clname
+      REAL (kind=rl) :: zzs
+      INTEGER :: nn_count
+      !
+      nn_count = 0
+      SELECT CASE (TRIM(clname))
+      CASE ( 'a2o' )
+         !> a -> o
+         DO jo = 1, jpon
+            zzs = SUM (wa2o (:,jo))
+            DO jno = 1, jma2o
+               ja = ka2o (jno, jo)
+               IF (ja > 0) THEN 
+                  IF (wa2o (jno, jo) < epsfrac) THEN 
+                     wa2o (jno, jo) = 0.0_rl
+                     ka2o (jno, jo) = 0_il
+                     nn_count = nn_count + 1
+                  ENDIF
+               ENDIF
+            END DO
+         END DO
+         WRITE (nout,*) 'rem small a2o : ', nn_count
+         !
+      CASE ( 'o2a' )
+         DO ja = 1, jpan
+            zzs = SUM (wo2a (:, ja))
+            DO jna = 1, jmo2a
+               jo = ko2a (jna, ja)
+               IF (jo > 0) THEN 
+                  IF (wo2a (jna, ja) < epsfrac) THEN 
+                     wo2a (jna, ja) = 0.0_rl
+                     ko2a (jna, ja) = 0_il
+                     nn_count = nn_count + 1
+                  END IF
+               END IF
+            END DO
+         END DO
+         WRITE (nout,*) 'rem small o2a : ', nn_count
+         !
+      END SELECT
+      !
+      WRITE (nout,*) 'Appel de gather (', TRIM(clname),') dans rem_small'
+      CALL gather (clname)
+      !
+   END SUBROUTINE rem_small
+   !
+END PROGRAM mosaic
+!
Index: /TOOLS/MOZAIC/src/MOZAIC/neuf.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/neuf.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/neuf.f90	(revision 3326)
@@ -0,0 +1,128 @@
+! -*- Mode: f90 -*-
+MODULE mod_neuf
+CONTAINS
+   SUBROUTINE neuf
+      !>
+      !! One ocean grid box sea an atmospheric grid boxes if it is above one
+      !! point T, u, v or f :
+      !!    sketch of an ocean grid box
+      !!
+      !!       f(ji-1,jj)--------v(ji,jj)-----------f(ji,jj)
+      !!                |                           |
+      !!       u(ji-1,jj)        T(ji,jj)           u(ji,jj)
+      !!                |                           |
+      !!     f(ji-1,jj-1)-------v(ji,jj-1)----------f(ji,jj-1)
+      !!
+      !!
+      !! Original     : Olivier MARTI, juin 96
+      !!
+      USE declare
+      USE modeles
+      USE formula
+      !!
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il) :: ja, jo, jai, jaj, joi, joj, jn ! Dummy indexes
+      !!
+      !! Generation of weights
+      !!
+      ! Initialisation
+      wo2a = zero ; ko2a = 0 ; wa2o = zero ; ka2o = 0 ; nva = 0 ; nvo = 0 ; nborda = 0 ; nbordo = 0
+      WRITE ( unit = nout, fmt = *)
+      WRITE ( unit = nout, fmt = *) 'Number of points to compute : ', jpan
+      Seek_atmos: DO ja = 1, jpan ! Loop over atmospheric grid points
+         IF ( iamskt ( ja) == 1 .AND. .NOT. lmaska ) THEN ! This point is not considered
+            nva  ( ja)   = -1
+            ko2a (ja, 1) =  0
+            CYCLE  Seek_atmos
+         ENDIF
+         jai = MOD ( ja - 1, jpai) + 1 ; jaj = ( ja - 1) / jpai + 1   ! 2D index of atm box
+         Seek: DO jo = 1, jpon
+            ! 
+            joi = MOD ( jo - 1, jpoi) + 1 ; joj = ( jo - 1) / jpoi + 1 ! Indices 2D
+            IF ( joi == 1 .OR. joi == jpoi .OR. joj == 1 .OR. joj == jpoj ) CYCLE Seek ! 
+            IF (  iomskt (jo) .EQ. 1 .AND. .NOT. lmasko ) THEN  ! This point is not considered
+               nborda ( ja) = 1
+               CYCLE Seek
+            END IF
+            nsum = 0
+            IF( dedans(xolont(jo       ),xaw(ja),xae(ja)) .AND. dedans(xolatt(jo       ),yas(ja),yan(ja))) nsum=nsum+4 ! Point T
+            IF( dedans(xolonu(jo       ),xaw(ja),xae(ja)) .AND. dedans(xolatu(jo       ),yas(ja),yan(ja))) nsum=nsum+2 ! Point u Right
+            IF( dedans(xolonu(jo-1     ),xaw(ja),xae(ja)) .AND. dedans(xolatu(jo-1     ),yas(ja),yan(ja))) nsum=nsum+2 ! Point u Left
+            IF( dedans(xolonv(jo       ),xaw(ja),xae(ja)) .AND. dedans(xolatv(jo       ),yas(ja),yan(ja))) nsum=nsum+2 ! Point v Upper
+            IF( dedans(xolonv(jo-jpoi  ),xaw(ja),xae(ja)) .AND. dedans(xolatv(jo-jpoi  ),yas(ja),yan(ja))) nsum=nsum+2 ! Point v Lower
+            IF( dedans(xolonf(jo       ),xaw(ja),xae(ja)) .AND. dedans(xolatf(jo       ),yas(ja),yan(ja))) nsum=nsum+1 ! Point f UR
+            IF( dedans(xolonf(jo-1     ),xaw(ja),xae(ja)) .AND. dedans(xolatf(jo-1     ),yas(ja),yan(ja))) nsum=nsum+1 ! Point f UL
+            IF( dedans(xolonf(jo-jpoi  ),xaw(ja),xae(ja)) .AND. dedans(xolatf(jo-jpoi  ),yas(ja),yan(ja))) nsum=nsum+1 ! Point f LR
+            IF( dedans(xolonf(jo-jpoi-1),xaw(ja),xae(ja)) .AND. dedans(xolatf(jo-jpoi-1),yas(ja),yan(ja))) nsum=nsum+1 ! Point f LL 
+            !! 
+            Trouve: IF ( nsum /= 0 ) THEN ! This ocean point is under the atm point
+               IF ( nva ( ja) >= jpo2a ) THEN
+                  WRITE ( unit = nout, fmt = *) 'Not enough ocean neighbors in ', jai, jaj, xalont(ja),xalatt(ja)
+                  EXIT Seek
+               END IF
+               nva ( ja) = nva ( ja) + 1
+               jmo2a = MAX ( jmo2a, nva ( ja))
+               ko2a ( ja, nva ( ja)) = jo 
+               ! Poids = surface ponderee par le nombre de points
+               wo2a ( ja, nva ( ja)) = REAL ( nsum, kind = rl) / 16.0 * xosrft ( jo)
+               IF ( nvo ( jo) >= jpa2o ) THEN
+                  WRITE ( unit = nout, fmt = *) 'Not enough atm neighbors in ', joi, joj, xolont ( jo), xolatt ( jo)
+                  EXIT Seek
+               ENDIF
+               nvo ( jo) = nvo ( jo) + 1
+               jma2o = MAX ( jma2o, nvo ( jo))
+               ka2o ( jo, nvo ( jo)) = ja
+               wa2o ( jo, nvo ( jo)) = REAL ( nsum, kind = rl) / 16.0 * xosrft ( jo)
+            END IF Trouve
+         END DO Seek
+      END DO Seek_atmos
+      !!
+      !! Correction a la main (mers fermées )
+      !! grep maille pts_pbs_mozaic | awk '{print "  CALL correct(",$3,",",$4,",",$7,",",$8,")"}'
+      !!
+      !! Check points isoles
+      !!
+      WRITE ( nout, *) 'Atmos point with no oce point below : i, j, lon, lat, west, est, south, north '
+      DO ja = 1, jpan
+         IF ( nva ( ja) == 0 .AND. iamskt ( ja) == 0 ) THEN 
+            jai = m2ai  ( ja) ; jaj = m2aj ( ja) ! Indices 2D de la maille atm
+            WRITE ( unit = nout, fmt = '(2I4,6F8.1)' ) jai, jaj, xalont ( ja), xalatt ( ja), xaw ( ja), &
+               & xae ( ja), yas ( ja), yan ( ja)
+         END IF
+      END DO
+      WRITE ( nout, *) 'Oce point with no atm point above : i, j, lon, lat '
+      DO jo = 1, jpon
+         IF  ( nvo ( jo) == 0 .AND. iomskt ( jo) == 0 ) THEN
+            joi = MOD ( jo - 1, jpoi) + 1 ; joj = ( jo - 1) / jpoi + 1 ! Indices 2D
+            IF ( joi == 1 .OR. joi == jpoi ) EXIT
+            WRITE ( unit = nout, fmt =  '(2I4,6F8.1)') joi, joj, xolont ( jo), xolatt ( jo)
+         ENDIF
+      END DO
+      ! check for some points
+      DO jai = 40, 40
+         jaj = 24
+         ja = m1a ( jai, jaj)
+         WRITE ( unit = nout, fmt = *) ' '
+         WRITE ( unit = nout, fmt = *) ' Check of atm point : ', jai,jaj, xalont(ja),xalatt(ja),nva(ja),iamskt(ja)
+         DO jn = 1, nva ( ja)
+            jo = ko2a ( ja, jn)
+            WRITE ( unit = nout, fmt = *) '  point oce ',jn,jo,xolont ( jo), xolatt ( jo),iomskt(jo),wo2a(ja,jn)
+         END DO
+         WRITE ( unit = nout, fmt = *) ' sum ', SUM ( wo2a ( ja,:))
+         WRITE ( unit = nout, fmt = *) ' '
+      END DO
+      !!
+      !! Sortie visuelle du nb de points sous les mailles atmos
+      WRITE( unit = ndeb, fmt = * ) ' Nomber of point under atmos box - nva'
+      WRITE( unit = ndeb, fmt = '(96I2)' ) nva
+      !!
+      WRITE ( unit = nout, fmt = *) ' '
+      WRITE ( unit = nout, fmt = *) ' jma2o : ', jma2o
+      WRITE ( unit = nout, fmt = *) ' jmo2a : ', jmo2a
+      WRITE ( unit = nout, fmt = *) ' maxi of nvo : ', MAXVAL ( nvo)
+      WRITE ( unit = nout, fmt = *) ' maxi of nva : ', MAXVAL ( nva)
+      !!
+   END SUBROUTINE neuf
+  !!
+END MODULE mod_neuf
Index: /TOOLS/MOZAIC/src/MOZAIC/norma.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/norma.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/norma.f90	(revision 3326)
@@ -0,0 +1,199 @@
+! -*- Mode: f90 -*-
+MODULE mod_norma
+CONTAINS
+   SUBROUTINE norma (knorma2o, knormo2a ) 
+      !>
+      !! Normalize weights
+      !!
+      !! Ocean to atmosphere : intensive variables (i.e. temperature). Constant field should stay constant
+      !!
+      !! Atmosphere to ocean : extensive variables (fluxes) . Should conserve integral of fields
+      !!
+      USE declare
+      USE modeles
+      !!
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il), INTENT (in) :: knorma2o, knormo2a
+      REAL    (kind=rl) :: zzz, zrplus, zrminus
+      REAL    (kind=rd) :: zzd
+      INTEGER (kind=il) :: ja, jo, jn
+      REAL    (kind=il), DIMENSION (jpan) :: zsuma
+      REAL    (kind=il), DIMENSION (jpon) :: zsumo
+      !!
+      WRITE (unit = nout, fmt = *) 'Normalisation atm : ', knormo2a
+      WRITE (unit = nout, fmt = *) 'Normalisation oce : ', knorma2o
+      zzz = 0.0_rl ; zsuma = 0.0_rl ; zsumo = 0.0_rl ; zzd = 0.0_rd
+      zrplus  = 1.0_rl +  2.0_rl*EPSILON(1.0_rl)
+      zrminus = 1.0_rl -  2.0_rl*EPSILON(1.0_rl)         
+      WRITE(nout,fmt='("facteur correction ", 3(1PE23.15))' ) zrplus, zrplus-1.0_rd, zrminus, zrminus-1.0_rd
+      !!
+      Normalize_A2O: IF (lwra2o ) THEN
+         IF      (knorma2o == 0) THEN 
+            WRITE (unit = nout, fmt = *) 'Normalisation atmosphere -> ocean : none'
+            ! --------------
+         ELSE IF (knorma2o == 1) THEN 
+            WRITE (unit = nout, fmt = *) 'Normalisation atmosphere -> ocean : intensive'
+            nsum = 0
+            DO jo = 1, jpon
+               zzd = SUM (REAL (wa2o(:,jo), rd) )
+               IF (zzd /= 0.0_rd) THEN
+                  wa2o (:,jo) = REAL (REAL (wa2o(:,jo),rd) / zzd, rl)
+                  zzd = SUM (REAL(wa2o(:,jo), rd))
+                  IF (  zzd > 1.0_rd ) THEN 
+                     !$$$                     WRITE (unit = nout, fmt = '("Phase 1 Pb 1 with normalisation a2o : ", 1I8, 2(1PE15.5))' ) &
+                     !$$$                        jo, zzd, zzd-1.0_rd
+                     wa2o(:,jo) = wa2o(:,jo) * zrminus
+                  END IF
+                  IF (zzd < 1.0-rd-epsfrac  ) THEN 
+                     !$$$                     WRITE (unit = nout, fmt = '("Phase 1 Pb 1 with normalisation a2o : ", 1I8, 2(1PE15.5))' ) &
+                     !$$$                        jo, zzd, zzd-1.0_rd
+                     wa2o(:,jo) = wa2o(:,jo) * zrplus
+                  END IF
+                  !$$$               ELSE 
+                  !$$$                  IF (o2amask(ja) > 0.0_rl) THEN 
+                  !$$$                     WRITE (unit = nout, fmt = '("Phase 1, Pb 2 with normalisation a2o  : ", 1I8, 2(1PE25.6))' ) &
+                  !$$$                        & ja, zzd, o2amask(ja)
+                  !$$$                  ENDIF
+               END IF
+            END DO
+            DO jo = 1, jpon
+               zzd = SUM (REAL (wa2o(:,jo), rd) )
+               IF ( zzd /= 0.0_rd .AND. (zzd < 1.0_rd-epsfrac .OR.  zzd > 1.0_rd+epsd) ) THEN 
+                  WRITE (unit = nout, fmt = '("Phase 2, Pb with normalisation : ", 1I8, 2(1PE15.5))' ) &
+                     jo, zzd, zzd-1.0_rd
+               END IF
+            END DO
+            ! ------------
+         ELSE IF (knorma2o == 2) THEN 
+            WRITE (unit = nout, fmt = *) 'Normalisation atmosphere -> ocean : extensive'
+            WRITE (unit = nout, fmt = *) 'Cumulating surfaces'
+            zsuma = 0.0_rl
+            DO jo = 1, jpon
+               DO jn = 1, jma2o
+                  ja = ka2o(jn,jo)
+                  IF (ja > 0 ) zsuma(ja) = zsuma(ja) + xosrft(jo) * wa2o(jn,jo) * REAL(1-iomskt(jo),kind=rl) &
+                     &  * REAL(1-iomskp(jo),kind=rl)
+               END DO
+            END DO
+            !!
+            WRITE (unit = nout, fmt = *) 'Computes surface fraction'
+            DO ja = 1, jpan
+               zzz = o2amask(ja)
+               IF (zzz > epsfrac .AND. xasrft(ja) .GE. epsfrac) THEN
+                  zzz = zzz * xasrft(ja)
+                  zsuma(ja) = zsuma(ja) / zzz
+               ELSE
+                  zsuma(ja)  = 0.0_rl
+               ENDIF
+               IF (ja == jpan-jpai+1 ) WRITE(nout,*) 'c ', ja, o2amask(ja), zzz, zsuma(ja), xasrft(ja)
+            END DO
+            !!
+            WRITE (unit = nout, fmt = *) 'Normalize weights'
+            DO jo = 1, jpon
+               DO jn = 1, jma2o
+                  ja = ka2o(jn,jo)
+                  IF (ja > 0 ) THEN 
+                     zzz = zsuma(ja)
+                     IF (zzz /= 0.0_rl) THEN 
+                        wa2o(jn,jo) = wa2o(jn,jo) / zzz
+                     ELSE
+                        wa2o(jn,jo) = 0.0_rl
+                     END IF
+                  END IF
+               END DO
+            END DO
+         ELSE
+            WRITE (unit = nout, fmt = *) 'Normalisation atmosphere -> ocean '
+            STOP 002
+         END IF
+      ELSE
+         WRITE (unit = nout, fmt = *) 'No normalisation atmosphere -> ocean'
+      END IF Normalize_A2O
+      !! ----
+      Normalize_O2A: IF (lwro2a ) THEN 
+         IF      (knormo2a == 0 ) THEN 
+            WRITE (unit = nout, fmt = *) 'Normalisation ocean -> atmosphere : none'
+         ELSE IF (knormo2a == 1 ) THEN
+            WRITE (unit = nout, fmt = *) 'Normalisation ocean -> atmosphere : intensive'
+            nsum = 0
+            DO ja = 1, jpan
+               zzd = SUM (REAL (wo2a(:,ja), rd) )
+               IF (zzd /= 0.0_rd) THEN
+                  wo2a (:,ja) = REAL (REAL (wo2a(:,ja),rd) / zzd, rl)
+                  zzd = SUM (REAL(wo2a(:,ja), rd))
+                  IF (zzd < 1.0_rd-epsfrac  ) THEN 
+                     !$$$                     WRITE (unit = nout, fmt = '("Phase 1 Pb 1 with normalisation : ", 1I8, 2(1PE15.5))' ) &
+                     !$$$                        ja, zzd, zzd-1.0_rd
+                     wo2a(:,ja) = wo2a(:,ja) * zrplus
+                  END IF
+                  IF (  zzd > 1.0_rd ) THEN 
+                     !$$$                     WRITE (unit = nout, fmt = '("Phase 1 Pb 1 with normalisation : ", 1I8, 2(1PE15.5))' ) &
+                     !$$$                        ja, zzd, zzd-1.0_rd
+                     wo2a(:,ja) = wo2a(:,ja) * zrminus
+                  END IF
+               ELSE 
+                  IF (o2amask(ja) > 0.0_rl) THEN 
+                     WRITE (unit = nout, fmt = '("Phase 1, Pb 2 with normalisation : ", 1I8, 2(1PE25.6))' ) &
+                        & ja, zzd, o2amask(ja)
+                  ENDIF
+               END IF
+            END DO
+            DO ja = 1, jpan
+               zzd = SUM (REAL (wo2a(:,ja), rd) )
+               IF ( zzd /= 0.0_rd .AND. (zzd < 1.0_rd-epsfrac .OR.  zzd > 1.0_rd+epsd) ) THEN 
+                  WRITE (unit = nout, fmt = '("Phase 2, Pb with normalisation : ", 1I8, 2(1PE15.5))' ) &
+                     ja, zzd, zzd-1.0_rd
+               END IF
+            END DO
+
+         ELSE IF (knormo2a == 2 ) THEN 
+            WRITE (unit = nout, fmt = *) 'Normalisation ocean -> atmosphere : extensive'
+            WRITE (unit = nout, fmt = *) 'Cumulating surfaces'
+            zsumo = 0.0_rl
+            DO ja = 1, jpan
+               DO jn = 1, jmo2a
+                  jo = ko2a(jn,ja)
+                  !$$$                IF (jo == jpon-jpoi+1 ) WRITE(nout,*) 'o ', ja, jn, jo, xasrft(ja), wo2a(jn,ja), iamskt(ja), iamskp(ja), a2omask(jo)  
+                  IF (jo > 0 ) zsumo(jo) = zsumo(jo) + xasrft(ja) * o2amask(ja) * wo2a(jn,ja) * REAL(1-iamskt(ja),kind=rl) &
+                     &  * REAL(1-iamskp(ja),kind=rl)
+               END DO
+            END DO
+            !!
+            WRITE (unit = nout, fmt = *) 'Computes surface fraction'
+            DO jo = 1, jpon
+               IF (iomskt(jo) == 0 .AND. xosrft(jo) .GE. epsfrac ) THEN
+                  zsumo(jo) = zsumo(jo) / xosrft(jo)
+               ELSE
+                  zsumo(jo)  = 0.0_rl
+               ENDIF
+               IF (jo == jpon-jpoi+1 ) WRITE(nout,*) 'c ', jo, zsumo(jo), xosrft(jo)
+            END DO
+            !!
+            WRITE (unit = nout, fmt = *) 'Normalize weights'
+            DO ja = 1, jpan
+               DO jn = 1, jmo2a
+                  jo = ko2a(jn,ja)
+                  !$$$                IF (jo == jpon-jpoi+1 ) WRITE(nout,*) 'd ', jo, ja, jn, a2omask(jo), zsumo(jo), xosrft(jo), wo2a(jn,ja)
+                  IF (jo > 0 ) THEN 
+                     zzz = zsumo(jo)
+                     IF (zzz  /= 0.0_rl ) THEN 
+                        wo2a(jn,ja) = wo2a(jn,ja) / zzz 
+                     ELSE
+                        wo2a(jn,ja) = 0.0_rl
+                     END IF
+                  END IF
+               END DO
+            END DO
+         ELSE
+            WRITE (unit = nout, fmt = *) 'Normalisation ocean -> atmosphere '
+            STOP 004
+         END IF
+      ELSE
+         WRITE (unit = nout, fmt = *) 'No normalisation ocean -> atmosphere'
+      END IF Normalize_O2A
+      !!
+      RETURN
+   END SUBROUTINE norma
+END MODULE mod_norma
+
Index: /TOOLS/MOZAIC/src/MOZAIC/norma2.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/norma2.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/norma2.f90	(revision 3326)
@@ -0,0 +1,89 @@
+! -*- Mode: f90 -*-
+SUBROUTINE norma
+!!!
+!!! Normalize weights
+!!!
+!!! Ocean to atmosphere : intensive variables (i.e. temperature). Constant field should stay constant
+!!!
+!!! Atmosphere to ocean : extensive variables (fluxes) . Should conserve integral of fields
+!!!
+  USE declare
+  USE modeles
+  !!
+  IMPLICIT NONE
+  !!
+  REAL (kind=rl) :: zzz, zsum
+  INTEGER (kind=il) :: ja, jo, jn, ko, kom
+  INTEGER (kind=il), DIMENSION ( jpo2a, 2) :: jxo
+  !!
+  IF ( lwra2o ) THEN
+      WRITE ( unit = nout, fmt = *) 'Normalisation atmosphere -> ocean'
+      !! Normalisation is OK for extensive variables (Heat flux, ....)
+      CALL flush(nout)
+      DO ja = 2, jpan
+        zzz = zero
+        kom = 0
+        IF ( MOD ( ja,  20) == 0 ) WRITE ( UNIT = nout, FMT = '( 1I6)', ADVANCE = 'NO' ) ja
+        IF ( MOD ( ja, 100) == 0 ) WRITE ( UNIT = nout, FMT = *)
+        DO jo = 2, jpon
+          DO jn = 1, jpa2o
+            IF (  ka2o ( jo, jn) == ja .AND. iomskp ( jo) < 0.5 .AND. ( lmasko .OR. iomskt ( jo) == 0 ) ) THEN 
+                zzz = zzz + xosrft ( jo) * wa2o ( jo, jn)
+                kom = kom + 1
+                IF ( kom > jpo2a ) THEN
+                    WRITE ( unit = nout, fmt = '("Too many ocean points : ", 6I6) ') ja, jo, jn, kom, ka2o ( jo, jn)
+                END IF
+                jxo ( kom, :) = (/ jo, jn /)
+                IF ( ndebug >= 2 ) THEN
+                    WRITE ( unit = nout, fmt = '(6I6,16F18.6) ') ja, jo, jn, kom, jxo ( kom, :), &
+                       wa2o ( jo, jn), wa2o ( jxo ( kom, 1), jxo ( kom, 2)), zzz, &
+                       xosrft ( jo), xasrft ( ja)
+                END IF
+            END IF
+          END DO
+        ENDDO
+        !!
+        IF ( (1.0_rl - o2amask ( ja)) >= epsfrac ) THEN
+            zzz = zzz / ( xasrft ( ja) * (1.0_rl - o2amask ( ja)) )
+        ELSE
+            zzz = 0.0_rl
+        ENDIF
+        !!
+        IF ( kom /= 0 ) THEN 
+            DO ko = 1, kom
+              IF ( zzz == 0.0_rl ) THEN 
+                  wa2o ( jxo ( ko, 1), jxo ( ko, 2)) = 0.0_rl
+              ELSE
+                  wa2o ( jxo ( ko, 1), jxo ( ko, 2)) = wa2o ( jxo ( ko, 1), jxo ( ko, 2)) / zzz 
+              END IF
+              IF ( ndebug >= 2 ) THEN 
+                  WRITE ( unit = nout, fmt = '(4I6,16(1PE15.3)) ') ja, ko, jxo ( ko, :), &
+                     wa2o ( jxo ( kom, 1), jxo ( ko, 2)), zzz, xosrft ( jxo ( ko, 1)), xasrft ( ja)
+              END IF
+            END DO
+        END IF
+      ENDDO
+  ELSE
+      WRITE ( unit = nout, fmt = *) 'No normalisation atmosphere -> ocean'
+  END IF
+  IF ( lwro2a ) THEN 
+      WRITE ( unit = nout, fmt = *) 'Normalisation ocean -> atmosphere'
+      !! Normalisation is OK for intensives variables (Temperature, ...)
+      CALL flush(nout)
+      nsum = 0
+      DO ja = 1, jpan
+        zsum = SUM ( wo2a ( ja, :) )
+        IF ( zsum /= 0 ) THEN
+            wo2a ( ja, :) = wo2a ( ja, :) / zsum
+        END IF
+        zsum = SUM ( wo2a ( ja, :))
+        IF ( ABS ( zsum) > zeps .AND. ABS ( zsum - 1.0) > zeps ) THEN 
+            WRITE ( unit = nout, fmt = '("Pb with normalisation : ", 1I6, 1(1PE15.3))' ) jo, zsum
+        END IF
+      END DO
+  ELSE
+      WRITE ( unit = nout, fmt = *) 'No normalisation ocean -> atmosphere'
+  END IF
+  !!
+  RETURN
+END SUBROUTINE norma
Index: /TOOLS/MOZAIC/src/MOZAIC/polom.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/polom.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/polom.f90	(revision 3326)
@@ -0,0 +1,144 @@
+! -*- mode: f90 -*-
+MODULE mod_polom
+CONTAINS
+  !
+  SUBROUTINE orien (pw)
+    !!
+    !! Orientation d'un triangle
+    !!
+    USE declare
+    USE u_polyg
+    !!
+    IMPLICIT NONE
+    TYPE (polyg), INTENT(inout) :: pw
+    REAL (kind=rp) :: zprod
+    !!
+    IF ( pw%n /= 3 ) STOP 123
+    !!
+    zprod =  &
+       &   (pw%pt(2)%x-pw%pt(1)%x) &
+       & * (pw%pt(3)%y-pw%pt(2)%y) &
+       & - (pw%pt(3)%x-pw%pt(2)%x) & 
+       & * (pw%pt(2)%y-pw%pt(1)%y)
+    !!
+    IF ( zprod < 0.0_rp ) THEN 
+        WRITE(nout,*) 'avant ', pw%pt(1:pw%n)
+        pw%pt(1:pw%n:1) = pw%pt(pw%n:1:-1)
+        WRITE(nout,*) 'apres ',  pw%pt(1:pw%n)
+    ENDIF
+    !!
+  END SUBROUTINE orien
+  !
+  SUBROUTINE polom (x1_in, y1_in, x2_in, y2_in, zsurf_1, zsurf_2, zsurf)
+    !---------------------------------------------------------------------
+    !- surfaces d'intersection de polygones
+    !---------------------------------------------------------------------
+    USE u_polyg
+    USE declare
+    USE mod_build
+    !-
+    IMPLICIT NONE
+    !-
+    REAL (kind=rd), DIMENSION (:), INTENT (in) :: x1_in, y1_in
+    REAL (kind=rd), DIMENSION (:), INTENT (in) :: x2_in, y2_in
+    REAL (kind=rd), INTENT ( out) :: zsurf_1, zsurf_2, zsurf
+    !-
+    INTEGER (kind=il) :: npd1, npd2
+    !-
+    REAL (kind=rd), DIMENSION (SIZE(x1_in)) :: x1, y1
+    REAL (kind=rd), DIMENSION (SIZE(x2_in)) :: x2, y2
+    TYPE (polyg) :: pp1, pp2
+    TYPE (polyg), DIMENSION (SIZE(x1_in)-1) :: pd1
+    TYPE (polyg), DIMENSION (SIZE(x2_in)-1) :: pd2
+    TYPE (polyg) :: pw
+    INTEGER (kind=il) :: k1, k2, k, jn
+    REAL (kind=rd) :: spp1, spp2, spp, f_ech
+    !-
+    INTEGER (kind=il), PARAMETER :: i_eor = -2, i_eof = -1
+    !-
+    LOGICAL, PARAMETER :: ld = .FALSE.
+    !-
+    x1 = x1_in ; y1 = y1_in ; x2 = x2_in ; y2 = y2_in
+    !---------------------------------------------------------------------
+    !- Build polygones
+    npd1 = SIZE (x1_in) - 1
+    npd2 = SIZE (x2_in) - 1
+    CALL build_poly ( x1(npd1:1:-1), y1(npd1:1:-1), pp1 )
+    CALL build_poly ( x2(npd2:1:-1), y2(npd2:1:-1), pp2 )
+    !-
+    !- facteur de normalisation ------------------------------------------
+    spp1    = p_srf(pp1)
+    zsurf_1 = spp1
+    DO jn = 1, 3
+       f_ech = SQRT ( p_srf(pp1))
+       IF (ld) WRITE (unit=*,fmt='(" f_echelle : ", 1pe13.5)') f_ech
+       x1 = x1 / f_ech ; y1 = y1 / f_ech
+       x2 = x2 / f_ech ; y2 = y2 / f_ech
+!-$$       IF ( jn == 3 .AND. ABS ( f_ech - 1.0_rd) .GE. SQRT ( EPSILON ( 1.0_r_4) ) ) THEN
+!-$$       END IF
+       CALL build_poly ( x1(npd1:1:-1), y1(npd1:1:-1), pp1 )
+    END DO
+    CALL build_poly ( x2(npd2:1:-1), y2(npd2:1:-1), pp2 )
+    f_ech = SQRT ( p_srf(pp1))
+    IF ( ABS ( f_ech - 1.0_rd) .GE. SQRT (EPSILON (1.0_r_4) ) ) THEN
+        WRITE (unit=nout,fmt=*) 'Erreur normalisation poly : ', f_ech
+    END IF
+    !
+    IF (ld) WRITE (UNIT=*,FMT='("PP1 X ", 8(1PE10.2))') pp1%pt(1:npd1)%x
+    IF (ld) WRITE (UNIT=*,FMT='("PP1 Y ", 8(1PE10.2))') pp1%pt(1:npd1)%y
+    IF (ld) WRITE (UNIT=*,FMT='("PP2 X ", 8(1PE10.2))') pp2%pt(1:npd2)%x
+    IF (ld) WRITE (UNIT=*,FMT='("PP2 Y ", 8(1PE10.2))') pp2%pt(1:npd2)%y
+    !
+    ! - Calcul de la surface
+    zsurf = 0.0_rd
+    !- Traitement des intersections --------------------------------------
+    spp1 = p_srf (pp1) ; spp2 = p_srf (pp2)
+    zsurf_2 = spp2 * zsurf_1
+
+    IF (ld) WRITE ( UNIT=*, FMT='(" surface 1 : ", 1PE10.3)') spp1
+    IF (ld) WRITE ( UNIT=*, FMT='(" surface 2 : ", 1PE10.3)') spp2
+    !--- Decoupage du polygone 1 en triangles
+    DO k1 = 1, npd1
+      k = k1+1 ; IF (k > npd1) k = 1
+      CALL build_poly ( (/ x1(k1), x1(npd1+1), x1(k) /), (/ y1(k1), y1(npd1+1), y1(k) /), pd1(k1) )
+!$$$      CALL p_orp (pd1(k1))
+!!$      CALL orien (pd1(k1))
+    END DO
+    !--- Decoupage du polygone 2 en triangles
+    DO k2 = 1, npd2
+      k = k2+1 ; IF (k > npd2) k = 1
+      CALL build_poly ( (/ x2(k2), x2(npd2+1), x2(k) /), (/ y2(k2), y2(npd2+1), y2(k) /), pd2(k2) )
+!$$$      CALL p_orp (pd2(k2))
+!!$      CALL orien (pd2(k2))
+    END DO
+    !
+    IF (ld)  WRITE (*,'(" --> ",i5," polygones")') npd1
+    Decoup1: DO k1 = 1, npd1
+      spp = p_srf (pd1 (k1))
+      IF ( spp < zeps ) CYCLE
+      IF (ld) WRITE ( UNIT=*, FMT='(" surface 1 ", I3," : ", 1PE10.3)') k1, spp
+      IF (ld) WRITE (*,'(" --> ",i5," polygones")') npd2
+      Decoup2: DO k2 = 1, npd2
+        spp = p_srf ( pd2(k2))
+        IF ( spp < zeps ) CYCLE
+        IF (ld) WRITE (unit=*,fmt='(" surface 2 ",i3," : ", 1PE10.3)') k2, spp
+        !--------- intersections 1 - 2
+        IF (ld) WRITE (UNIT=*, FMT='(" intersection 1 ", 1(I4)," - 2 ", 1(I4))') k1, k2
+        CALL p_pcp ( pd1(k1), pd2(k2), pw)
+        IF (pw%n > 0) THEN
+            IF (ld) WRITE (*,'(" intersection :")')
+            spp = p_srf (pw)
+            zsurf = zsurf + spp
+            IF (ld) WRITE (unit=*,fmt='(" surface : ", 1PE10.3)') spp
+        ELSE
+            IF (ld) WRITE (*,'(" pas d''intersection")')
+        ENDIF
+      ENDDO Decoup2
+    ENDDO Decoup1
+    !
+!$$$    WRITE ( UNIT = *, FMT = * ) 'zsurf : ', zsurf
+    !----------------
+    RETURN
+    !
+  END SUBROUTINE polom
+END MODULE mod_polom 
Index: /TOOLS/MOZAIC/src/MOZAIC/polyw_a.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/polyw_a.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/polyw_a.f90	(revision 3326)
@@ -0,0 +1,429 @@
+! -*- Mode: f90 -*-
+MODULE mod_polyw_a
+CONTAINS
+   SUBROUTINE polyw_a (lo2a, la2o)
+      !>
+      !! Compute weights by exact by distance
+      !!
+      USE declare
+      USE modeles
+      USE math
+      USE formula
+      USE mod_proj
+      USE u_polyg
+      USE mod_polom
+      USE mod_lbc
+      !!
+      IMPLICIT NONE
+      !!
+      REAL (kind=rd), DIMENSION (:), ALLOCATABLE :: xa, ya
+      REAL (kind=rd), DIMENSION (:), ALLOCATABLE :: xo, yo !> Polygons coordinates (last is center of polygon)
+      REAL (kind=rd) :: xp, yp !> Pole of projection
+
+      REAL (kind=rp) :: zra, zro, zr !> Radius of projected boxes 
+      REAL (kind=rp) :: zga, zgo, zg !> Radius of boxes 
+      REAL (kind=rd) :: zsa, zso, zs !> Surface of boxes (in cartesian coordinates)
+      REAL (kind=rp), DIMENSION (:), ALLOCATABLE :: xat_p, yat_p
+
+      INTEGER (kind=il) :: kproj = 2 !> Type of projection
+      INTEGER (kind=il) :: kaerr(jpae), koerr(jpoe) !> Error code of projection
+      INTEGER (kind=il) :: ja, jo, jo2, jai, jaj, joi, joj, jn, nto, no !> Dummy indexes
+      LOGICAL (kind=il) :: lwrite  !> For test outputs
+      INTEGER (kind=il) :: ld = 1 , ld_t !> Debug flag
+      INTEGER (kind=il) :: np=0 ! Comptage de print
+      REAL (kind = rl) :: xoloninf, xolonsup, yolatinf, yolatsup
+      REAL (kind = rl) :: xaloninf, xalonsup, yalatinf, yalatsup
+      REAL (kind=rl) :: dx, dy
+      LOGICAL, INTENT (in) :: lo2a, la2o
+      REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xat_n, yat_n, xat_s, yat_s
+      INTEGER (kind=il) :: kerr_p(jpai+1) !> Error code of projection
+      LOGICAL :: la_nor, la_sud
+      !!
+      ALLOCATE (xa (jpae))
+      ALLOCATE (ya (jpae))
+      ALLOCATE (xo (jpoe))
+      ALLOCATE (yo (jpoe))
+      !!
+      !!
+      IF ( la_pole ) THEN ! Bug, uniquement pour grille reguliere ...
+         ALLOCATE (xat_n(jpai+1))
+         ALLOCATE (yat_n(jpai+1))
+         ALLOCATE (xat_s(jpai+1))
+         ALLOCATE (yat_s(jpai+1))
+         ALLOCATE (xat_p(jpai+1))
+         ALLOCATE (yat_p(jpai+1))
+         DO jai = 1, jpai
+            IF ( la_nortop ) THEN
+               xat_s (jai) = xae ( m1a(jpai-jai+1, 1    ) )
+               xat_n (jai) = xaw ( m1a(jai       , jpaj ) )
+               yat_s (jai) = yan ( m1a(jpai      , 1    ) )
+               yat_n (jai) = yas ( m1a(jpai-jai+1, jpaj ) )
+            ELSE
+               xat_s (jai) = xae ( m1a(jai       , jpaj ) )
+               xat_n (jai) = xaw ( m1a(jpai-jai+1, 1    ) )
+               yat_s (jai) = yan ( m1a(jpai      , jpaj ) )
+               yat_n (jai) = yas ( m1a(jpai-jai+1, 1    ) )
+            END IF
+         END DO
+
+         xat_s (jpai+1) =   0.0_rl
+         xat_n (jpai+1) =   0.0_rl
+
+         yat_s (jpai+1) = -90.0_rl
+         yat_n (jpai+1) =  90.0_rl
+
+         WRITE (nout,*) "xat_s : ", xat_s
+         WRITE (nout,*) "yat_s : ", yat_s
+         WRITE (nout,*) "xat_n : ", xat_n
+         WRITE (nout,*) "yat_n : ", yat_n
+
+      END IF
+      !!
+      !! Generation of weights
+      !!
+      ! Initialisation
+      nto = 0
+      IF ( lo2a ) THEN 
+         jmo2a = 0 ; wo2a = zero ; ko2a = 0 ; nva = 0
+      END IF
+      IF ( la2o ) THEN 
+         jma2o = 0 ; wa2o = zero ; ka2o = 0 ; nvo = 0
+      ENDIF
+      nborda = 0 ; nbordo = 0
+      zra = zero ; zro = zero ; zsa = zero ; zso = zero ; zs = zero
+      WRITE (unit = nout, fmt = *)
+      WRITE ( unit = nout, fmt = *) 'Number of points to compute : ', jpan
+      !
+      !dx = 4.0_rl * 360.0_rl / REAL ( MIN ( jpai, jpaj, jpoi, jpoj), kind=rl)
+      !dy = 4.0_rl * 180.0_rl / REAL ( MIN ( jpai, jpaj, jpoi, jpoj), kind=rl)
+      
+      dx = MAXVAL ( ABS (xae-xaw))
+      dy = MAXVAL ( ABS (yan-yas))
+      WRITE(nout,*) 'polyw_a : dx, dy : ', dx, dy
+
+      !!
+      !! Atmosphere
+      OPEN ( unit = 36, file = 'poly.atm', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' )
+      !! Ocean
+      OPEN (unit = 37, file = 'poly.oce', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' )
+      !!
+      !
+      AtmosJ: DO jaj = 1, jpaj ! Loop over atmospheric grid points
+         ja = m1a (1, jaj)
+         AtmosI: DO jai = 1, jpai
+            ja = m1a (jai, jaj)
+            la_nor  =.FALSE. ; la_sud = .FALSE.
+            ld_t = ld
+            lwrite = .FALSE. 
+            no = 0
+            IF (ld_t <= 1) THEN
+               WRITE (UNIT=nout, FMT='(1I8," ")', ADVANCE='no') ja
+               np=np+1
+               IF (np > 15 ) THEN
+                  WRITE (UNIT=nout, FMT='(" ")') 
+                  CALL FLUSH(nout)                  
+                  np=0
+               END IF
+            ENDIF
+            xalonsup = MAXVAL (xa_ed(ja,1:jpae))
+            xaloninf = MINVAL (xa_ed(ja,1:jpae)) 
+            yalatsup = MAXVAL (ya_ed(ja,1:jpae))
+            yalatinf = MINVAL (ya_ed(ja,1:jpae)) 
+            
+            IF ( yalatinf < -89.99_rl ) la_sud = .TRUE.
+            IF ( yalatsup >  89.99_rl ) la_nor = .TRUE.
+            
+            !IF ( la_pole .AND. la_nor ) ld_t = 3
+
+            IF (iamskt (ja) == 1 .AND. .NOT. lmaska) THEN ! This point is not considered
+               IF (ld_t >= 2)  WRITE ( nout, fmt ='("rejected (Atm masked)",1I6,2I4)' ) ja, jai, jaj
+               CYCLE  AtmosI
+            END IF
+            IF (iamskp (ja) .EQ. 1 ) THEN  ! Periodicity point rejected
+               IF ( ld_t >= 4 ) WRITE (nout, fmt ='("rejected (Atm perio)",1I6,2I4)' ) ja, jai, jaj
+               CYCLE AtmosI
+            END IF
+
+            IF ( la_pole .AND. la_nor ) WRITE (nout,*) 'LMD North Pole'
+            IF ( la_pole .AND. la_sud ) WRITE (nout,*) 'LMD South Pole'
+
+            IF (      la_pole .AND. la_nor ) THEN
+               xalonsup = MAXVAL (xat_n)
+               xaloninf = MINVAL (xat_n)
+               yalatsup = 90.0_rl
+               yalatinf = MINVAL ( yat_n)
+            ELSE IF ( la_pole .AND. la_sud ) THEN
+               xalonsup = MAXVAL (xat_s)
+               xaloninf = MINVAL (xat_s)
+               yalatsup = -90.0_rl
+               yalatinf = MAXVAL ( yat_n)
+            END IF
+
+            IF (ld_t >= 2)  WRITE ( nout, fmt ='("Working on atm : ", 1I6,2I4,6F8.1,2I2)' ) &
+               & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), xaloninf, xaloninf, yalatinf, yalatsup, iamskt (ja), iamskp (ja)
+
+            IF ( xaloninf > xo_sup+dx .OR. xalonsup < xo_inf-dx ) THEN ! This point is not considered
+               IF (ld_t >= 2)  WRITE ( nout, fmt ='("rejected (Atm point outside oce latitude limits )",1I6,2I4,2F8.1)' ) &
+                  & ja, jai, jaj, yalatinf, yalatsup 
+               CYCLE  AtmosI
+            END IF
+            IF ( yalatinf > yo_sup+dy .OR. yalatsup < yo_inf-dy ) THEN ! This point is not considered
+               IF (ld_t >= 2)  WRITE ( nout, fmt ='("rejected (Atm point outside oce longitude limits)",1I6,2I4,2F8.1)' ) &
+                  &ja, jai, jaj, xaloninf, xaloninf
+               CYCLE  AtmosI
+            END IF
+       
+            !!
+            zga = 0.0_rl
+           
+            IF (      la_pole .AND. la_nor ) THEN 
+               DO jn = 1, jpai
+                  zga = MAX (zga, cartdist (xat_n(jn), yat_n(jn), 0.0_rl,  90.0_rl ))
+               END DO
+            ELSE IF (      la_pole .AND. la_sud ) THEN 
+               DO jn = 1, jpai
+                  zga = MAX (zga, cartdist (xat_s(jn), yat_s(jn), 0.0_rl, -90.0_rl ))
+               END DO
+            ELSE
+               DO jn = 1, jpae-1
+                  zga = MAX (zga, cartdist (xa_ed(ja,jn), ya_ed(ja,jn), xa_ed(ja,jpae), ya_ed(ja,jpae) ) )
+            END DO
+            END IF
+
+            !! Project atm edges
+            IF (      la_pole .AND. la_sud ) THEN
+               xp = xat_s (jpai+1) ; yp = yat_s (jpai+1)
+            ELSE IF ( la_pole .AND. la_nor ) THEN 
+               xp = xat_n (jpai+1) ; yp = yat_n (jpai+1)
+            ELSE
+               xp = xa_ed (ja,jpae) ; yp = ya_ed (ja,jpae) ! Projection pole : center of atmospherix box
+            END IF
+            IF (ld_t >= 2) WRITE (nout, fmt ='("working on atm : ", 1I6,2I4,11(2F8.1))') &
+               & ja, jai, jaj, xa_ed(ja,:), ya_ed(ja,:), yalatinf, yalatsup
+            DO jn = 1, jpae
+               CALL proj ( xa_ed(ja,jn), ya_ed(ja,jn), xp, yp, xa(jn), ya(jn), kproj, kaerr(jn) ) ! Project atm box
+            END DO
+            !! Radius of atmospheric box in cartesian coordinates
+            zra = 0.0_rl
+            DO jn = 1, jpae-1
+               zra = MAX ( zra, ddist (xa(jn), ya(jn), xa(jpae), ya(jpae)) )
+            END DO
+            !!
+            OceanJ: DO joj = 1, jpoj
+               jo = m1o ( 1, joj) 
+               OceanI: DO joi = 1, jpoi
+                  jo = m1o ( joi, joj) 
+                  !!
+                  ! Masked point
+                  IF ( iomskt (jo) .EQ. 1 .AND. .NOT. lmasko) THEN
+                     IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (Oce masked)",2(1I6,2I4))') ja, jai, jaj, jo, joi, joj
+                     IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (mask ) : ",2(1I6,2I4,2F8.1,1F8.4))') & 
+                        & ja, jai, jaj, xp, yp, zra, jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro
+                     CYCLE OceanI
+                  END IF
+                  
+                  ! Periodicity
+                  IF (iomskp (jo) .EQ. 1 ) THEN  ! Periodicity point rejected
+                     IF (ld_t >= 4) WRITE ( nout, fmt ='("rejected (Oce perio) : ",2(1I6,2I4,2F8.1,1F8.4))') &
+                        & ja, jai, jaj, xp, yp, zra, jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro
+                     CYCLE OceanI
+                  END IF
+                  !
+                  ld_t = ld
+                  !
+                  !IF (ld_t <= 1) THEN
+                  !   WRITE (UNIT=nout, FMT='("jo=",1I8," ")', ADVANCE='no') jo
+                  !   CALL FLUSH(nout)
+                  !ENDIF
+                  !
+                  xolonsup = MAXVAL(xo_ed(jo,:))
+                  xoloninf = MINVAL(xo_ed(jo,:)) 
+                  yolatsup = MAXVAL(yo_ed(jo,:))
+                  yolatinf = MINVAL(yo_ed(jo,:)) 
+                  IF ( yolatsup > 85.0_rl ) yolatsup = 90.0_rl
+                  !IF ( joj == jpoj-1 .AND. yolatsup > 87.0_rl .AND. yalatsup > 85.0_rl) ld_t = 3
+
+                  ! Latitude limits criterion
+                  IF ( dehors (yalatinf-dy, yalatsup+dy, yolatinf-dy, yolatsup+dy) ) THEN ! Boxes do not overlap
+                     IF (ld_t >= 3) WRITE ( nout, fmt ='("rejected (lat) : ",2(1I6,2I4,4F8.2))') & 
+                        & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), yalatinf, yalatsup, & 
+                        & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), yolatinf, yolatsup
+                     CYCLE OceanI
+                  END IF
+                
+                  !!
+                  zgo = 0.0_rd
+                  DO jn = 1, jpoe-1
+                     zgo = MAX (zgo, cartdist (xo_ed(jo,jn), yo_ed(jo,jn), xo_ed(jo,jpoe), yo_ed(jo,jpoe)))
+                  ENDDO
+
+                  !! Geographical distance criterion
+                  zg = REAL (cartdist (xa_ed(ja,jpae), ya_ed(ja,jpae), xo_ed(jo,jpoe), yo_ed(jo,jpoe)),KIND=rd)
+                  IF (zg .GE. 1.2_rd * (zgo + zga)) THEN ! Boxes do not overlap
+                     IF (ld_t >= 3) WRITE (nout, fmt ='("rejected (cartdist) : ",2(1I6,2I4,2F8.1,1E14.3),1E14.3)') & 
+                        & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zga, &
+                        & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zgo, &
+                        & zg
+                     CYCLE OceanI
+                  END IF
+                  !! Project ocean edges
+                  DO jn = 1, jpoe
+                     CALL proj ( xo_ed(jo,jn), yo_ed(jo,jn), xp, yp, xo(jn), yo(jn), kproj, koerr(jn) )
+                  END DO
+                  IF ( SUM(koerr) /= 0 ) THEN
+                     IF ( ld >= 2) WRITE ( nout, fmt ='("rejected (kerr) : ",2(1I6,2I4,2F8.1,1F8.4))') &
+                        & ja, jai, jaj, xp, yp, zra, jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro
+                     CYCLE OceanI
+                  END IF
+                  IF (ld_t >= 3) THEN 
+                     WRITE (nout, fmt ='("working on oce : ", 1I6,2I4,4F8.1)') jo, joi, joj, xoloninf, xolonsup, yolatinf, yolatsup
+                  END IF
+                  !! Distance criterion
+                  zro = 0.0_rd
+                  DO jn = 1, jpoe - 1
+                     zro = MAX (zro, ddist (xo(jn), yo(jn), xo(jpoe), yo(jpoe)))
+                  END DO
+                  zr = ddist (xa(jpae), ya(jpae), xo(jpoe), yo(jpoe)) ! Distance between center of atm and oce grid boxes
+                  IF (zr .GE. 5.0 * (zro + zra)) THEN ! Boxes do not overlap
+                     IF (ld_t >= 3) WRITE (nout, &
+                        & fmt ='("rejected (dist) : ", 1I6,2I4,2F8.1,1F8.4, 1I6, 2I4, 2F8.1, 1F8.4)') & 
+                        & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra, jo, joi, joj, xp, yp, zro
+                     CYCLE OceanI
+                  END IF
+                  IF (ld_t >=3) WRITE (nout, fmt ='("accepted : ", 2(1I6,2I4,2F8.1,1E13.4),1E13.4)' ) &
+                     & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra, & 
+                     & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro, &
+                     & zr 
+                  !! Find surface of intersection. Surface is given as the ratio between intersection and atm box
+                  IF ( la_pole ) THEN
+                     !! Special handling at poles
+                     IF      ( yalatinf < -89.99_rl ) THEN 
+                        DO jn = 1, jpai+1
+                           CALL proj (xat_s(jn), yat_s(jn), xp, yp, xat_p(jn), yat_p(jn), kproj, kerr_p(jn))
+                        ENDDO
+                        CALL polom (xat_p, yat_p, xo, yo, zsa, zso, zs)
+                     ELSE IF ( yalatsup >  89.99_rl ) THEN 
+                        DO jn = 1, jpai+1
+                           CALL proj (xat_n(jn), yat_n(jn), xp, yp, xat_p(jn), yat_p(jn), kproj, kerr_p(jn))
+                        END DO
+                        CALL polom (xat_p, yat_p, xo, yo, zsa, zso, zs)
+                     ELSE 
+                        CALL polom (xa, ya, xo, yo, zsa, zso, zs)
+                     ENDIF
+                  ELSE
+                     CALL polom  (xa, ya, xo, yo, zsa, zso, zs) 
+                  ENDIF
+                  !!
+                  IF ( zs < zeps ) THEN ! Boxes do not overlap
+                     IF (ld >= 3 ) WRITE ( nout, fmt ='("rejected (poly) : ",2(1I6,2I4,2F8.1),1E13.4)') & 
+                        & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), &
+                        & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), &
+                        & zs
+                     CYCLE OceanI
+                  END IF
+                  IF (ld_t >= 2) WRITE ( nout, fmt ='("accepted (final) : ",2(1I6,2I4,2F8.1,1E13.4),3(1PE13.4))') &
+                     & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra, &
+                     & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro, &
+                     & zsa, zso, zs
+                  !!
+                  IF (ld_t >= 3) THEN 
+                     WRITE (nout, fmt = '(9E10.2)') xa(:)
+                     WRITE (nout, fmt = '(9E10.2)') ya(:)
+                     WRITE (nout, fmt = '(9E10.2)') xo(:)
+                     WRITE (nout, fmt = '(9E10.2)') yo(:)
+                  END IF
+                  IF (lo2a) THEN 
+                     IF ( nva (ja) >= jpo2a ) THEN
+                        WRITE ( unit = nout, fmt = '("Not enough oce neighbors in : ", 3I6, 5F8.1)' ) &
+                           & jai, jaj, nva(ja), xa_ed(ja,jpae), ya_ed(ja,jpae), yalatinf, yalatsup
+                        WRITE ( unit = nout, fmt = *)  'xa_ed : ', xa_ed(ja,:)
+                        WRITE ( unit = nout, fmt = *)  'ya_ed : ', ya_ed(ja,:)
+                        WRITE ( unit = nout, fmt = *) "xp, yp : ", xp, yp
+                        WRITE ( unit = nout, fmt = *) "xa : ", xa
+                        WRITE ( unit = nout, fmt = *) "ya : ", ya
+                        WRITE (nout, fmt = *) &
+                           & "jn,jo2,m2oi(jo2),m2oj(jo2),wo2a(jn,ja), ", &
+                           & "xo_ed(jo2,jpoe),yo_ed(jo2,jpoe),xo_ed(jo2,:),yo_ed(jo2,:)"
+                        DO jn = 1, nva (ja) 
+                           jo2 = ko2a (jn,ja)
+                           WRITE (nout, fmt = *) &
+                              & jn,jo2,m2oi(jo2),m2oj(jo2),wo2a(jn,ja), &
+                              & xo_ed(jo2,jpoe),yo_ed(jo2,jpoe),xo_ed(jo2,:),yo_ed(jo2,:)
+                        END DO
+                        STOP
+                        EXIT OceanI
+                     END IF
+                     !
+                     nva(ja) = nva(ja) + 1
+                     jmo2a = MAX (jmo2a, nva(ja))
+                     ko2a (nva(ja), ja) = jo 
+                     ! Weights : surface of intersection
+                     wo2a (nva(ja), ja) = REAL (zs, KIND = rl)
+                     IF ( wo2a (nva(ja), ja) > 1.0_rl+SQRT(epsfrac) ) THEN 
+                        WRITE ( nout, fmt='("o2a >1 ",2(1I6,2I3, 2F8.1),1I3,1E13.4)' )  &
+                           &  ja,jai,jaj, xa_ed(ja,jpae), ya_ed(ja,jpae)&
+                           &, jo,joi,joj, xo_ed(ja,jpae), yo_ed(jo,jpoe), jn, wo2a(nva(ja),ja)
+                        WRITE (nout, fmt = '("xa : ", 9E10.2)') xa(:)
+                        WRITE (nout, fmt = '("ya : ", 9E10.2)') ya(:)
+                        WRITE (nout, fmt = '("xo : ", 9E10.2)') xo(:)
+                        WRITE (nout, fmt = '("yo : ", 9E10.2)') yo(:)
+                        WRITE (nout, fmt = '("surface : ", 9E10.2)') xosrft(ja), xasrft (ja), zro, zra, zgo, zga, zso, zsa, zs
+                     END IF
+                  END IF
+                  !
+                  IF (la2o) THEN 
+                     IF (nvo (jo) >= jpa2o ) THEN
+                        WRITE (unit = nout, fmt = '("Not enough atm neighbors in : ", 3I6, 6F8.1)' ) &
+                           &  joi, joj, nvo(jo), xolont(jo), xolatt(jo), yolatinf, yolatsup
+                        WRITE (unit = nout, fmt = *) jai, jaj, nva(ja), xa_ed(ja,jpae), ya_ed(ja,jpae), yalatinf, yalatsup
+                        WRITE (unit = nout, fmt = *)  'xa_ed : ', xa_ed(ja,:)
+                        WRITE (unit = nout, fmt = *)  'ya_ed : ', ya_ed(ja,:)
+                        WRITE (unit = nout, fmt = *)  'xo_ed : ', xo_ed(ja,:)
+                        WRITE (unit = nout, fmt = *)  'yo_ed : ', yo_ed(ja,:)
+                        WRITE (unit = nout, fmt = *) zs
+                        STOP
+                        EXIT OceanI
+                     ENDIF
+                     nvo (jo) = nvo (jo) + 1
+                     jma2o = MAX (jma2o, nvo (jo))
+                     ka2o (nvo(jo), jo) = ja
+                     !! Choix entre 2 formules de calcul
+                     !wa2o = zs * zsa / zso
+                     wa2o (nvo(jo), jo) = zs * xasrft(ja) / xosrft(jo)
+!-$$                     IF (wa2o (nvo (jo), jo) > 1.0_rl+epsfrac ) THEN 
+!-$$                        WRITE (nout, fmt='("a2o >1 ",2(1I6,2I4),1I4,1E13.4)' ) &
+!-$$                           & ja,jai,jaj,jo,joi,joj,jn,wa2o(nvo(jo),jo)
+!-$$                        WRITE (nout, fmt = '(9E10.2)') xa(:)
+!-$$                        WRITE (nout, fmt = '(9E10.2)') ya(:)
+!-$$                        WRITE (nout, fmt = '(9E10.2)') xo(:)
+!-$$                        WRITE (nout, fmt = '(9E10.2)') yo(:)
+!-$$                     END IF
+                     !!
+                  ENDIF
+                  no = no + 1
+                  !
+               END DO OceanI
+            END DO OceanJ
+            nto = no + nto 
+         END DO AtmosI
+      END DO AtmosJ
+      !!
+      WRITE ( nout, fmt = '("Total points : ", 1I6 , ", Average : ", 1F9.3, " oce points per atm point" )' ) &
+         & nto, REAL(nto,KIND=rl) / REAL(jpan,KIND=rl)
+      !!
+      IF (la2o) THEN 
+         jma2o = MAXVAL (nvo)
+         jma2o = MIN (jma2o, jpa2o)
+      ENDIF
+      IF (lo2a) THEN 
+         jmo2a = MAXVAL (nva)
+         jmo2a = MIN (jmo2a, jpo2a)
+      END IF
+      !!
+      WRITE (nout, fmt = *) jpa2o, jma2o, jpo2a, jmo2a
+      !!
+      CLOSE (unit = 36)
+      CLOSE (unit = 37)
+      !!
+   END SUBROUTINE polyw_a
+END MODULE mod_polyw_a
Index: /TOOLS/MOZAIC/src/MOZAIC/polyw_a_fast.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/polyw_a_fast.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/polyw_a_fast.f90	(revision 3326)
@@ -0,0 +1,119 @@
+! -*- Mode: f90 -*-
+MODULE mod_polyw_a_fast
+CONTAINS
+   SUBROUTINE polyw_a_fast (lo2a, la2o)
+!!! 
+!!! Compute weights fastly
+!!!
+      USE declare
+      USE modeles
+      USE math
+      USE formula
+      USE mod_proj
+      !!
+      IMPLICIT NONE
+      !!
+      INTEGER (kind=il) :: ja, jo, jo2, jai, jaj, joi, joj, jn, nto, no ! Dummy indexes
+      LOGICAL (kind=il) :: lwrite  ! For test outputs
+      INTEGER (kind=il) :: ld = 1 , ld_t ! Debug flag
+      REAL (kind=rl) :: zmin
+      LOGICAL, INTENT (in) :: lo2a, la2o
+      !!
+      !! Generation of weights
+      !!
+      ! Initialisation
+      nto = 0
+      IF ( lo2a ) THEN 
+         jmo2a = 0 ; wo2a = zero ; ko2a = 0 ; nva = 0
+      END IF
+      IF ( la2o ) THEN 
+         jma2o = 0 ; wa2o = zero ; ka2o = 0 ; nvo = 0
+      ENDIF
+      WRITE (unit = nout, fmt = *)
+      WRITE ( unit = nout, fmt = *) 'Number of points to compute : ', jpan
+      !
+      !!
+      Atmos: DO ja = 1, jpan, 1 ! Loop over atmospheric grid points
+         ld_t = ld
+         lwrite = .FALSE. 
+         no = 0
+         jai = m2ai(ja) ; jaj = m2aj(ja)   ! 2D indexes of atm box
+         yalatsup = MAXVAL (ya_ed(ja:ja,1:jpae))
+         yalatinf = MINVAL (ya_ed(ja:ja,1:jpae)) 
+         IF (iamskt (ja) == 1 .AND. .NOT. lmaska) THEN ! This point is not considered
+            IF (ld >= 4)  WRITE ( nout, fmt ='("rejected (Atm masked)",1I6,2I4)' ) ja, jai, jaj
+            CYCLE  Atmos
+         END IF
+         IF (iamskp (ja) .EQ. 1_il ) THEN  ! Periodicity point rejected
+            IF ( ld_t >= 4 ) WRITE (nout, fmt ='("rejected (Atm perio)",1I6,2I4)' ) ja, jai, jaj
+            CYCLE Atmos
+         END IF
+         zmin = REAL (cartdist (0.0_rl, 0.0_rl, 180.0_rl, 0.0_rl), KIND=rd)
+         !!
+         Ocean: DO jo = 1, jpon
+            !!
+            joi = m2oi(jo) ; joj = m2oj(jo) ! 2D indexes
+            IF ( iomskt (jo) .EQ. 1 .AND. .NOT. lmasko) THEN  ! This point is not considered
+               IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (Oce masked)",2(1I6,2I4))') ja, jai, jaj, jo, joi, joj
+               IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (mask ) : ",2(1I5,2I4,2F8.1,1F8.4))') & 
+                  & ja, jai, jaj, xp, yp, zra, jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro
+               CYCLE Ocean
+            END IF
+            IF (iomskp (jo) .EQ. 1_il ) THEN  ! Duplicated point rejected
+               IF (ld_t >= 4) WRITE ( nout, fmt ='("rejected (Oce perio) : ",2(1I6,2I4,2F8.1,1F8.4))') &
+                  & ja, jai, jaj, xp, yp, zra, jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro
+               CYCLE Ocean 
+            END IF
+            ! Latitude limits criterion
+            yolatsup = MAXVAL(yo_ed(jo,:)) ; yolatinf = MINVAL(yo_ed(jo,:)) 
+            IF ( dehors (yalatinf-dy, yalatsup+dy, yolatinf-dy, yolatsup+dy) ) THEN ! Boxes do not overlap
+               IF (ld_t >= 3) WRITE ( nout, fmt ='("rejected (lat) : ",2(1I6,2I4,4F8.2))') & 
+                  & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), yalatinf, yalatsup, & 
+                  & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), yolatinf, yolatsup
+               CYCLE Ocean
+            END IF
+            !!
+            ENDDO
+            !! Geographical distance criterion
+            zg = REAL (cartdist (xa_ed (ja,jpae), ya_ed (ja,jpae), xo_ed (jo,jpoe), yo_ed (jo,jpoe)), KIND=rd)
+            IF (zg < zmin) THEN 
+               ka2o (1, jo) = ja
+               ko2a (1, ja) = jo
+               nvo (jo) = 1
+               nva (ja) = 1
+               wa2o (jo) = 1.0_rl
+               wo2a (ja) = 1.0_rl
+            END IF
+            !
+         END DO Atmos
+         !!
+      END DO Atmos
+      !!
+      WRITE ( nout, fmt = '("Total points : ", 1I5 , ", Average : ", 1F9.3, " oce points per atm point" )' ) &
+         & nto, REAL(nto,KIND=rl) / REAL(jpan,KIND=rl)
+      !!
+      !$$$    IF ( lo2a ) THEN 
+      !$$$        DO ja = 1, jpan
+      !$$$          IF ( ABS ( SUM(wo2a(ja,:)) - 1.0_rl ) > SQRT(zeps) ) THEN 
+      !$$$              jai = m2ai ( ja) ; jaj = m2aj ( ja) 
+      !$$$              WRITE ( nout, fmt = '("pb sum : ", 3I5, " : ", 2(F9.1), " : ", 1PE15.6)' ) ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), SUM(wo2a(ja,:))
+      !$$$          END IF
+      !$$$        END DO
+      !$$$    ENDIF
+      !!
+      IF (la2o) THEN 
+         jma2o = MAXVAL (nvo)
+         jma2o = MIN (jma2o, jpa2o)
+      ENDIF
+      IF (lo2a) THEN 
+         jmo2a = MAXVAL (nva)
+         jmo2a = MIN (jmo2a, jpo2a)
+      END IF
+      !!
+      WRITE (nout, fmt = *) jpa2o, jma2o, jpo2a, jmo2a
+      !!
+      CLOSE (unit = 36)
+      CLOSE (unit = 37)
+      !!
+   END SUBROUTINE polyw_a
+END MODULE mod_polyw_a
Index: /TOOLS/MOZAIC/src/MOZAIC/polyw_o.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/polyw_o.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/polyw_o.f90	(revision 3326)
@@ -0,0 +1,347 @@
+! -*- Mode: f90 -*-
+MODULE mod_polyw_o
+CONTAINS
+   SUBROUTINE polyw_o (lo2a, la2o)
+      !>
+      !! Compute weights by exact intersection of polygones
+      !!
+      USE declare
+      USE modeles
+      USE math
+      USE formula
+      USE mod_proj
+      USE u_polyg
+      USE mod_polom
+      USE mod_lbc
+      !!
+      IMPLICIT NONE
+      !!
+      REAL (kind=rd), DIMENSION (:), ALLOCATABLE :: xa, ya
+      REAL (kind=rd), DIMENSION (:), ALLOCATABLE :: xo, yo !> Polygons coordinates (last is center of polygon)
+      REAL (kind=rd) :: xp, yp !> Pole of projection
+      REAL (kind=rp) :: zra, zro, zr !> Radius of projected boxes 
+      REAL (kind=rp) :: zga, zgo, zg !> Radius of boxes 
+      REAL (kind=rd) :: zsa, zso, zs !> Surface of boxes (in cartesian coordinates)
+      INTEGER (kind=il) :: kproj = 2 !> Type of projection
+      INTEGER (kind=il) :: kaerr(jpae), koerr(jpoe) !> Error code of projection
+      INTEGER (kind=il) :: ja, jo, jo2, jai, jaj, joi, joj, jn, nta, na !> Dummy indexes
+      LOGICAL (kind=il) :: lwrite  !> For test outputs
+      INTEGER (kind=il) :: ld = 1 , ld_t !> Debug flag
+      REAL (kind = rl) :: xoloninf, xolonsup, yolatinf, yolatsup
+      REAL (kind = rl) :: xaloninf, xalonsup, yalatinf, yalatsup
+      REAL (kind=rl) :: dx, dy
+      LOGICAL, INTENT (in) :: lo2a, la2o
+      REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: xat_n, yat_n, xat_s, yat_s
+      REAL (kind=rp), DIMENSION (:), ALLOCATABLE :: xat_p, yat_p
+      INTEGER (kind=il) :: kerr_p(jpai+1) !> Error code of projection
+      !!
+      ALLOCATE (xa (jpae))
+      ALLOCATE (ya (jpae))
+      ALLOCATE (xo (jpoe))
+      ALLOCATE (yo (jpoe))
+      !!
+      ALLOCATE (xat_n(jpai+1))
+      ALLOCATE (yat_n(jpai+1))
+      ALLOCATE (xat_s(jpai+1))
+      ALLOCATE (yat_s(jpai+1))
+      ALLOCATE (xat_p(jpai+1))
+      ALLOCATE (yat_p(jpai+1))
+      !!
+      DO jai = 1, jpai
+         xat_s(jai) = -180.0_rl + 360.0_rl * REAL(jai-1,KIND=rl) / REAL(jpai,KIND=rl) 
+         xat_n(jai) = +180.0_rl - 360.0_rl * REAL(jai-1,KIND=rl) / REAL(jpai,KIND=rl) 
+      END DO
+      xat_s(jpai+1) = 0.0_rl ; xat_n(jpai+1) = 0.0_rl
+      yat_s(1:jpai) = MAXVAL(ya_ed(1  ,:))   ; yat_s(jpai+1) = -90.0_rl
+      yat_n(1:jpai) = MINVAL(ya_ed(jpan,:))  ; yat_n(jpai+1) =  90.0_rl
+      !!
+      !! Generation of weights
+      !!
+      ! Initialisation
+      nta = 0
+      IF (lo2a) THEN 
+         jmo2a = 0 ; wo2a = zero ; ko2a = 0 ; nva = 0
+      END IF
+      IF ( la2o ) THEN 
+         jma2o = 0 ; wa2o = zero ; ka2o = 0 ; nvo = 0
+      ENDIF
+      nborda = 0 ; nbordo = 0
+      zra = zero ; zro = zero ; zsa = zero ; zso = zero ; zs = zero
+      WRITE (unit = nout, fmt = *)
+      WRITE (unit = nout, fmt = *) 'Number of points to compute : ', jpon
+      !
+      dx = 4.0_rl * 360.0_rl / REAL ( MIN ( jpai, jpaj, jpoi, jpoj), kind=rl)
+      dy = 4.0_rl * 180.0_rl / REAL ( MIN ( jpai, jpaj, jpoi, jpoj), kind=rl)
+
+      !!
+      !! Atmosphere
+      OPEN ( unit = 36, file = 'poly.atm', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' )
+      !! Ocean
+      OPEN (unit = 37, file = 'poly.oce', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' )
+      !!
+      Ocean: DO jo = 1, jpon ! Loop over ocean grid points
+         ld_t = ld
+         lwrite = .FALSE. 
+         na = 0
+         joi = m2oi(jo) ; joj = m2oj(jo) ! 2D indexes of oce box
+         xolonsup = MAXVAL (xo_ed(jo:jo,1:jpoe))
+         xoloninf = MINVAL (xo_ed(jo:jo,1:jpoe)) 
+         yolatsup = MAXVAL (yo_ed(jo:jo,1:jpoe))
+         yolatinf = MINVAL (yo_ed(jo:jo,1:jpoe))
+         IF ( yolatsup > 85.0_rl ) yolatsup = 90.0_rl
+         IF ( joj == jpoj-1 .AND. yolatsup > 87.0_rl .AND. yalatsup > 85.0_rl) ld_t = 3
+         
+         IF ( xoloninf > xa_sup+dx .OR. xolonsup < xa_inf-dx ) THEN ! This point is not considered
+            IF (ld_t >= 2)  WRITE ( nout, fmt ='("rejected (Oce point outside atm latitude limits)",1I6,2I4,2F8.1)' ) &
+               & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe)
+            CYCLE  Ocean
+         END IF
+         IF ( yolatinf > ya_sup+dy .OR. yolatsup < ya_inf-dy ) THEN ! This point is not considered
+            IF (ld_t >= 2)  WRITE ( nout, fmt ='("rejected (Oce point outside atm longitude limits)",1I6,2I4,2F8.1)' ) &
+               & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe)
+            CYCLE  Ocean
+         END IF
+
+         IF (iomskt (jo) .EQ. 1 .AND. .NOT. lmasko) THEN  ! This point is not considered
+            IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (Ocea masked)",1I6,2I4)') jo, joi, joj
+            CYCLE Ocean
+         END IF
+         IF (iomskp (jo) .EQ. 1_il) THEN  ! Periodicity point rejected
+            IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (Oce perio)",1I6,2I4)') jo, joi, joj
+            CYCLE Ocean 
+         END IF
+         !!
+         zgo = 0.0_rd
+         DO jn = 1, jpoe-1
+            zgo = MAX (zgo,  REAL(cartdist (xo_ed(jo,jn), yo_ed(jo,jn), xo_ed(jo,jpoe), yo_ed(jo,jpoe)), rl))
+         END DO
+         !! Project ocean edges
+         xp = xo_ed (jo,jpoe) ; yp = yo_ed (jo,jpoe) ! Projection pole : center of ocean box
+         IF (ld_t >= 2) WRITE (nout, fmt ='("working on oce : ", 1I5,2I4,11(2F8.1))') &
+            & jo, joi, joj, xo_ed(jo,:), yo_ed(jo,:), yolatinf, yolatsup
+         DO jn = 1, jpoe
+            CALL proj (xo_ed(jo,jn), yo_ed(jo,jn), xp, yp, xo(jn), yo(jn), kproj, koerr(jn)) ! Project ocean box
+         ENDDO
+         !! Radius of ocean box in cartesian coordinates
+         zro = 0.0_rd
+         DO jn = 1, jpoe-1
+            zro = MAX (zro, ddist (xo(jn), yo(jn), xo(jpoe), yo(jpoe)))
+         END DO
+         !! 
+         Atmos: DO ja = 1, jpan
+            !!
+            ld_t = ld
+            jai = m2ai(ja) ; jaj = m2aj(ja)   ! 2D atm indexes
+            xalonsup = MAXVAL(xa_ed(ja,:))
+            xaloninf = MINVAL(xa_ed(ja,:)) 
+            yalatsup = MAXVAL(ya_ed(ja,:))
+            yalatinf = MINVAL(ya_ed(ja,:)) 
+
+            ! Latitude limits criterion
+            IF (dehors (yolatinf-dy, yolatsup+dy, yalatinf-dy, yalatsup+dy)) THEN ! Boxes do not overlap
+               IF (ld_t >= 3) WRITE (nout, fmt ='("rejected (lat) : ",2(1I6,2I4,4F8.2))') &
+                  & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), yolatinf, yolatsup, &
+                  & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), yalatinf, yalatsup
+               CYCLE Atmos ! On peut passer toute la ligne atmosphere Ã  ce stade
+            END IF
+
+            ! Masked point
+            IF (iamskt (ja) == 1 .AND. .NOT. lmaska) THEN
+               IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (Atm masked)",2(1I6,2I4))') jo, joi, joj, ja, jai, jaj
+               IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (mask) : ",2(1I5,2I4,2F8.1,1F8.4))') & 
+                  & jo, joi, joj, xp, yp, zro, ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra
+               CYCLE  Atmos
+            END IF
+
+            ! Periodicity
+            IF (iamskp (ja) .EQ. 1_il) THEN
+               IF (ld_t >= 4) WRITE (nout, fmt ='("rejected (Atm perio)",2(1I6,2I4,2F8.1,1F8.4))') &
+                  jo, joi, joj, xp, yp, zra, ja, jai, jaj, xa_ed(jo,jpoe), ya_ed(ja,jpae), zra
+               CYCLE Atmos
+            END IF
+
+            !!
+            zga = 0.0_rd
+            DO jn = 1, jpae-1
+               zga = MAX (zga, cartdist (xa_ed(ja,jn), ya_ed(ja,jn), xa_ed(ja,jpae), ya_ed(ja,jpae)))
+            END DO
+            IF ( naperio == -1 ) THEN
+               !! Special handling at poles
+               IF ( jaj == 1 .OR. jaj == jpaj ) zga = 2.0_rl * zga 
+            END IF
+
+            !! Geographical distance criterion
+            zg = REAL(cartdist (xo_ed(jo,jpoe), yo_ed(jo,jpoe), xa_ed(ja,jpae), ya_ed(ja,jpae)),KIND=rd)
+            IF (zg .GE. 1.2_rd * (zga + zgo)) THEN ! Boxes do not overlap
+               IF (ld_t >= 3) WRITE (nout, fmt ='("rejected (cartdist) : ",2(1I5,2I4,2F8.1,1E13.4),1E13.4)') & 
+                  & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zgo, &
+                  & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zga, zg
+               CYCLE Atmos
+            END IF
+            !! Project atm edges
+            DO jn  = 1, jpae
+               CALL proj (xa_ed(ja,jn), ya_ed(ja,jn), xp, yp, xa(jn), ya(jn), kproj, kaerr(jn))
+            END DO
+            IF (SUM(kaerr(:)) /= 0) THEN
+               IF (ld_t >= 2) WRITE (nout, fmt ='("rejected (kerr) : ",2(1I5,2I4,2F8.1,1F8.4))') &
+                  & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro, ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra
+               CYCLE Atmos
+            END IF
+            IF (ld_t >= 3) THEN 
+               WRITE (nout, fmt ='("working on atm : ", 1I5,2I4,11(2F8.1))') ja, jai, jaj, xa_ed(ja,:), ya_ed(ja,:), &
+                  & yalatinf, yalatsup
+               !$$$            WRITE (nout, fmt = '(9E10.2)') xa(:)
+               !$$$            WRITE (nout, fmt = '(9E10.2)') ya(:)
+            END IF
+            !! Distance criterion
+            zra = 0.0_rd
+            DO jn = 1, jpae - 1
+               zra = MAX (zra, ddist (xa(jn), ya(jn), xa(jpae), ya(jpae)))
+            END DO
+            zr = ddist (xo(jpoe), yo(jpoe), xa(jpae), ya(jpae)) ! Distance between center of atm and oce grid boxes
+            IF (zr .GE. 5.0 * (zra + zro)) THEN ! Boxes do not overlap
+               IF (ld_t >= 3) WRITE (nout, fmt ='("rejected (dist) : ",2(1I5,2I4,2F8.1,1F8.4))') & 
+                  & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro, ja, jai, jaj, xp, yp, zra
+               CYCLE Atmos
+            END IF
+            IF (ld_t >=3) WRITE (nout, fmt ='("accepted         : ",2(1I5,2I4,2F8.1,1E13.4),1E13.4)') &
+               & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro, ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra, zr 
+
+            !! Find surface of intersection. Surface is given as the ratio between intersection and oce box
+            IF ( naperio == -1 ) THEN
+               !! Special handling at poles
+               IF      (jai == 1 .AND. jaj == 1   ) THEN 
+                  WRITE (nout,*) 'LMDZ South pole'
+                  DO jn = 1, jpai+1
+                     CALL proj (xat_s(jn), yat_s(jn), xp, yp, xat_p(jn), yat_p(jn), kproj, kerr_p(jn))
+                  ENDDO
+                  CALL polom (xo, yo, xat_p, yat_p, zso, zsa, zs)
+               ELSE IF (jai == 1 .AND. jaj == jpaj) THEN
+                  WRITE (nout,*) 'LMDZ North pole'
+                  DO jn = 1, jpai+1
+                     CALL proj (xat_n(jn), yat_n(jn), xp, yp, xat_p(jn), yat_p(jn), kproj, kerr_p(jn))
+                  END DO
+                  CALL polom (xo, yo, xat_p, yat_p, zso, zsa, zs)
+               ELSE 
+                  CALL polom (xo, yo, xa, ya, zso, zsa, zs)
+               ENDIF
+            ELSE
+               CALL polom (xo, yo, xa, ya, zso, zsa, zs) 
+            ENDIF
+            !!
+            IF (zs < zeps) THEN ! Boxes do not overlap
+               IF (ld_t >= 3) WRITE (nout, fmt ='("rejected (poly)  : ",2(1I6,2I4,2F8.1),1E13.4)') &
+                  & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zs
+               CYCLE Atmos
+            END IF
+            IF (ld_t >= 3) WRITE (nout, fmt ='("accepted (final) : ",2(1I5,2I4,2F8.1,1E13.4),3(1PE13.4))') &
+               & jo, joi, joj, xo_ed(jo,jpoe), yo_ed(jo,jpoe), zro, &
+               & ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), zra, &
+               & zsa, zso, zs
+            !!
+            IF (ld_t >= 2) THEN 
+               WRITE (nout, fmt = '(9E10.2)') xa(:)
+               WRITE (nout, fmt = '(9E10.2)') ya(:)
+               WRITE (nout, fmt = '(9E10.2)') xo(:)
+               WRITE (nout, fmt = '(9E10.2)') yo(:)
+            END IF
+            IF (lo2a) THEN 
+               IF ( nva (ja) >= jpo2a ) THEN
+                  WRITE ( unit = nout, fmt = '("Not enough oce neighbors in : ", 3I4, 2F8.1)' ) &
+                     & jai, jaj, nva(ja), xalont(ja), xalatt(ja)
+                  WRITE ( unit = nout, fmt = *)  'xa_ed : ', xa_ed(ja,:)
+                  WRITE ( unit = nout, fmt = *)  'ya_ed : ', ya_ed(ja,:)
+                  WRITE ( unit = nout, fmt = *) xp, yp, xa, ya
+                  DO jn = 1, nva (ja) 
+                     jo2 = ko2a (jn,ja)
+                     WRITE (nout, fmt = *) jn,jo2,m2oi(jo2),m2oj(jo2),wo2a(jn,ja), &
+                        & xolont(jo2),xolatt(jo2),xo_ed(jo2,:),yo_ed(jo2,:)
+                  END DO
+                  STOP
+                  EXIT Atmos
+               END IF
+               !
+               nva(ja) = nva(ja) + 1
+               jmo2a = MAX (jmo2a, nva(ja))
+               ko2a (nva(ja), ja) = jo 
+               ! Weights : surface of intersection
+               wo2a (nva(ja), ja) = REAL (zs, KIND = rl)
+               IF ( wo2a (nva(ja), ja) > 1.0_rl+epsfrac ) THEN 
+                  WRITE ( nout, fmt='("o2a >1 ",2(1I6,2I3),1I3,1E13.4)' )  ja,jai,jaj,jo,joi,joj,jn,wo2a(nva(ja),ja)
+                  WRITE (nout, fmt = '(9E10.2)') xa(:)
+                  WRITE (nout, fmt = '(9E10.2)') ya(:)
+                  WRITE (nout, fmt = '(9E10.2)') xo(:)
+                  WRITE (nout, fmt = '(9E10.2)') yo(:)
+               END IF
+            END IF
+            !
+            IF (la2o) THEN 
+               IF (nvo (jo) >= jpa2o ) THEN
+                  WRITE (unit = nout, fmt = '("Not enough atm neighbors in : ", 3I4, 2F8.1)' ) &
+                     &  joi, joj, nvo(jo), xolont(jo), xolatt(jo)
+                  WRITE (unit = nout, fmt = *) ja, jai, jaj, xalont(ja), xalatt(ja)
+                  WRITE (unit = nout, fmt = *) (ka2o(jn,jo), jn=1,jpa2o)
+                  WRITE (unit = nout, fmt = *) xo_ed(jo,:), yo_ed(jo,:)
+                  WRITE (unit = nout, fmt = *) zs
+                  STOP
+                  EXIT Atmos
+               ENDIF
+               nvo (jo) = nvo (jo) + 1
+               jma2o = MAX (jma2o, nvo (jo))
+               ka2o (nvo(jo), jo) = ja
+               !! Choix entre 3 formules de calcul
+               !wa2o = zs * zsa / zso
+               wa2o (nvo(jo), jo) = zs * xasrft(ja) / xosrft(jo)
+               !wa2o (nvo(jo),jo) = REAL (zs * xasrft_pol(ja) / xosrft_pol(jo), KIND=rl)
+               IF (wa2o (nvo (jo), jo) > 1.0_rl+epsfrac ) THEN 
+                  WRITE (nout, fmt='("a2o >1 ",2(1I6,2I3),1I3,1E13.4)' ) &
+                     & ja,jai,jaj,jo,joi,joj,jn,wa2o(nvo(jo),jo)
+                  WRITE (nout, fmt = '(9E10.2)') xa(:)
+                  WRITE (nout, fmt = '(9E10.2)') ya(:)
+                  WRITE (nout, fmt = '(9E10.2)') xo(:)
+                  WRITE (nout, fmt = '(9E10.2)') yo(:)
+               END IF
+               !!
+            ENDIF
+            na = na + 1
+            !
+         END DO Atmos
+         !!
+         IF (MOD(jo,jpon/100) .EQ. 0) WRITE (nout, fmt = '("O overlaping : ", 1I6, 2I4, 2F8.1, 2E10.2, 1I3, 1F12.5)') &
+            &   jo, joi, joj, xp, yp, zro, zso, na, SUM(wa2o(:,jo))
+         ! IF (MOD(jo,10) .EQ. 0) WRITE (UNIT=nout, FMT='(1I8)') jo
+         CALL flush (nout)
+         nta = na + nta
+         !!
+      END DO Ocean
+      !!
+      WRITE (UNIT=nout,FMT=*) 
+      !!
+      WRITE (nout, fmt = '("Total points : ", 1I9 , ", Average : ", 1F9.3, " atm points per oce point")') &
+         & nta, REAL(nta,KIND=rl) / REAL(jpon,KIND=rl)
+      !!
+      !$$$    IF ( lo2a ) THEN 
+      !$$$        DO ja = 1, jpan
+      !$$$          IF ( ABS ( SUM(wo2a(ja,:)) - 1.0_rl ) > SQRT(zeps) ) THEN 
+      !$$$              jai = m2ai ( ja) ; jaj = m2aj ( ja) 
+      !$$$              WRITE ( nout, fmt = '("pb sum : ", 3I5, " : ", 2(F9.1), " : ", 1PE15.6)' ) ja, jai, jaj, xa_ed(ja,jpae), ya_ed(ja,jpae), SUM(wo2a(ja,:))
+      !$$$          END IF
+      !$$$        END DO
+      !$$$    ENDIF
+      !!
+      IF (la2o) THEN 
+         jma2o = MAXVAL (nvo)
+         jma2o = MIN (jma2o, jpa2o)
+      ENDIF
+      IF (lo2a) THEN 
+         jmo2a = MAXVAL (nva)
+         jmo2a = MIN (jmo2a, jpo2a)
+      END IF
+      !!
+      WRITE (nout, fmt = *) jpa2o, jma2o, jpo2a, jmo2a
+      !!
+      CLOSE (unit = 36)
+      CLOSE (unit = 37)
+      !!
+   END SUBROUTINE polyw_o
+END MODULE mod_polyw_o
Index: /TOOLS/MOZAIC/src/MOZAIC/prih.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/prih.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/prih.f90	(revision 3326)
@@ -0,0 +1,207 @@
+! -*- Mode: f90 -*-
+MODULE mod_prih
+   !> Print 2D fields, with ad hoc formats
+   USE declare
+   IMPLICIT NONE
+CONTAINS
+   SUBROUTINE  prihre (ptab, pscale, kout, l_norsud)
+      !> Print 2D real fields, with ad hoc format
+      !!c
+      IMPLICIT NONE
+      !!
+      REAL   (kind=rl), DIMENSION (:, :), INTENT (in) :: ptab
+      LOGICAL, INTENT(in), OPTIONAL :: l_norsud 
+      INTEGER, INTENT (in), OPTIONAL :: kout
+      REAL    (kind=rl), INTENT (in), OPTIONAL :: pscale
+      INTEGER (kind=il) :: ki, kj, il1, il2, ji, jj, jn, isca, iout
+      REAL    (kind=rl) :: zscale
+      INTEGER (kind=il) :: j_deb, j_fin, j_inc
+
+      !
+      zscale = 1.0_rl 
+      iout   = 6
+      IF ( PRESENT (pscale)) zscale = pscale
+      IF ( PRESENT (kout))   iout   = kout
+      !
+      ki = SIZE (ptab, DIM=1)
+      kj = SIZE (ptab, DIM=2)
+      isca = 20
+      IF (zscale .NE. 0.) isca = 30
+      !
+      il1 = 1
+      !
+      j_deb=kj ; j_fin=1 ; j_inc=-1
+      IF ( PRESENT (l_norsud)) THEN 
+         IF ( l_norsud ) THEN
+            j_deb=1 ; j_fin=kj ; j_inc=1
+         END IF
+      END IF
+      DO jn = 1, (ki-1+1)/isca + 1
+         !
+         IF (il1 .GT. ki) RETURN 
+         !
+         WRITE (UNIT = iout, FMT = '(/)')
+         !
+         il2 = MIN(ki,il1+1*(isca-1))
+         IF (zscale .EQ. 0.) THEN 
+            WRITE (UNIT=iout, FMT = '(3X, 20I12, 1X, /)') (ji, ji = il1, il2, 1)
+            DO jj = kj, 1, -1
+               WRITE (UNIT=iout, FMT = '(1X, I3, 1X, 20(1PE12.4))') jj, ptab (il1:il2,jj)
+            END DO
+         ELSE 
+            WRITE (UNIT=iout, FMT ='(3X, 40I7, 1X, /)') (ji, ji = il1, il2, 1)
+            DO jj = j_deb, j_fin, j_inc
+               WRITE (UNIT=iout, FMT = '(1X, I3, 1X, 40(F7.2))   ') jj, zscale*ptab (il1:il2,jj)
+            END DO
+         END IF
+         il1 = il1 + 1 * isca
+         !
+      END DO
+      !
+      ! ---------------------------------------------------------------------
+      !
+   END SUBROUTINE prihre
+
+   SUBROUTINE  prihbo (ltab, kout, l_norsud)
+      !> Print 2D logical fields
+      !!c
+      IMPLICIT NONE
+      !!
+      LOGICAL, DIMENSION (:, :), INTENT (in) :: ltab
+      LOGICAL, INTENT(in), OPTIONAL :: l_norsud 
+      INTEGER, INTENT (in), OPTIONAL :: kout
+      INTEGER :: ki, kj
+      INTEGER :: il1, il2, ji, jj, jn, isca, iout
+      CHARACTER, DIMENSION (SIZE(ltab,1)) :: cltab
+      INTEGER :: j_deb, j_fin, j_inc
+
+      !
+      ki = SIZE (ltab, DIM=1) ; kj = SIZE (ltab, DIM=2)
+      isca = 200
+      iout = 6
+      IF ( PRESENT (kout)) iout = kout
+      !
+      il1 = 1
+      ! 
+      j_deb=kj ; j_fin=1 ; j_inc=-1
+      IF ( PRESENT (l_norsud)) THEN 
+         IF ( l_norsud ) THEN
+            j_deb=1 ; j_fin=kj ; j_inc=1
+         END IF
+      END IF
+      DO jn = 1, (ki-1+1)/(1*isca) + 1
+         !
+         IF (il1 .GT. ki) RETURN 
+         !
+         WRITE (UNIT = iout, FMT = '(/)')
+         !
+         il2 = MIN (ki, il1+1*(isca-1))
+         WRITE (UNIT = iout, FMT ='(1X,200I5, 1X, /)') (ji, ji = il1, il2, 1*5)
+         DO jj =  j_deb, j_fin, j_inc
+            cltab (:) = "."
+            WHERE (ltab(:,jj)) cltab = "*"
+            WRITE (UNIT = iout, FMT = '(1X, I3, 1X, 200(1A))   ') jj, cltab (il1:il2)
+         END DO
+         il1 = il1 + 1 * isca
+         !
+      END DO
+      !
+      ! ---------------------------------------------------------------------
+      !
+   END SUBROUTINE prihbo
+   !!
+   SUBROUTINE prihin (ktab, kscale, kout, l_norsud)
+      !> Print 2D integer fields, with ad hoc format
+      !!   Method :
+      !!   -------
+      !!      The format of print is selected with the dummy argument kscale
+      !!
+      !!   Input :
+      !!   -----
+      !!      Argument :
+      !!               ktab            : integer array for print
+      !!               kscale          : if kscale=0
+      !!                                 or if > 5   print ktab with format i8
+      !!                                 if kscale=1 print ktab with format i1
+      !!                                 if kscale=2 print ktab with format i2
+      !!                                 if kscale=3 print ktab with format i3
+      !!                                 if kscale=4 print ktab with format i4
+      !!                                 if kscale=5 print ktab with format i5
+      !!
+!!! -------------------------------------------------------------------
+!!!  OPA7, Lodyc (5/11/91)
+!!! -------------------------------------------------------------------
+      !
+      IMPLICIT NONE
+      !
+      INTEGER, INTENT (in), OPTIONAL :: kscale, kout
+      LOGICAL, INTENT(in), OPTIONAL :: l_norsud 
+      INTEGER, INTENT (in), DIMENSION (:,:) :: ktab
+      INTEGER :: ki, kj, il1, il2, ji, jj, jn, isca, iskip, iscale, iout
+      CHARACTER (LEN=30) :: clform1, clform2, clform3
+      CHARACTER (len=6), DIMENSION (:), ALLOCATABLE :: c_data
+      INTEGER :: j_deb, j_fin, j_inc
+      !
+      iscale = 3
+      iout   = 6
+      IF ( PRESENT (kscale)) iscale = kscale
+      IF ( PRESENT (kout))   iout   = kout
+      !
+      ki = SIZE (ktab, DIM=1) ; kj = SIZE (ktab, DIM=2)
+      !
+      ALLOCATE (c_data (ki))
+      !
+      SELECT CASE (iscale)
+      CASE (0) ; isca =  20_il ; iskip = 1_il
+      CASE (1) ; isca = 200_il ; iskip = 5_il
+      CASE (2) ; isca = 120_il ; iskip = 4_il
+      CASE (3) ; isca =  80_il ; iskip = 2_il
+      CASE (4) ; isca =  60_il ; iskip = 2_il
+      CASE (5) ; isca =  40_il ; iskip = 1_il
+      CASE (6) ; isca =  40_il ; iskip = 1_il
+      CASE Default 
+         isca =  20_il ; iskip = 1_il
+      END SELECT
+      !
+      il1 = 1
+      !
+      WRITE (UNIT=clform1, FMT='("(5X, "         , 1I3.3, "I", 1I3.3, ")" )' ) isca/iskip, iscale*iskip
+      WRITE (UNIT=clform2, FMT='("(1X, 1I3 ,1X, ", 1I3.3, "A", 1I2.2, ")" )' ) isca, iscale
+      WRITE (UNIT=clform3, FMT='("(I", 1I2.2,")")') iscale
+      !
+      ! ---------------------------------------------------------------------
+      !
+      j_deb=kj ; j_fin=1 ; j_inc=-1
+      IF ( PRESENT (l_norsud)) THEN 
+         IF ( l_norsud ) THEN
+            j_deb=1 ; j_fin=kj ; j_inc=1
+         END IF
+      END IF
+      DO jn = 1_il, (ki-1+1_il)/(1* isca) + 1_il
+         !
+         IF (il1 .GT. ki) RETURN 
+         WRITE (UNIT = iout, FMT = *) ' '
+         il2 = MIN ( ki, il1+1*(isca-1_il)) 
+         !
+         WRITE (UNIT = iout, FMT = clform1) (ji, ji = il1+iskip*1-1, il2, iskip)
+         WRITE (UNIT = iout, FMT = *) ' '
+         DO  jj = j_deb, j_fin, j_inc
+            DO ji = il1, il2
+               IF ( ktab (ji, jj) == 0 ) THEN 
+                  c_data (ji) = '......'
+               ELSE
+                  WRITE (UNIT=c_data(ji), FMT=clform3) ktab(ji,jj)
+               END IF
+            END DO
+            WRITE (UNIT = iout, FMT = clform2) jj, c_data (il1:il2)
+         END DO
+         !
+         il1 = il1 + 1* isca
+      END DO
+      !
+      ! ---------------------------------------------------------------------
+      !
+   END SUBROUTINE prihin
+   !!
+END MODULE mod_prih
+
Index: /TOOLS/MOZAIC/src/MOZAIC/proj.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/proj.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/proj.f90	(revision 3326)
@@ -0,0 +1,53 @@
+! -*- Mode: f90 -*-
+MODULE mod_proj
+CONTAINS
+   SUBROUTINE proj (plon, plat, plon0, plat0, px, py, ktype, kerr )
+!!!
+!!!
+!!! Projections between geographic to cartesian
+!!! type of projection : 
+!!!  1: from geographic to orthographic 
+!!!  2: from geographic to Lambert Equal Area 
+!!!
+    USE declare
+    USE u_polyg
+    IMPLICIT NONE
+    !!
+    !!
+    REAL (kind=rl), INTENT (in) :: plon , plat  ! Geographical coordinates of point to project
+    REAL (kind=rd), INTENT (in) :: plon0, plat0 ! Pole of projection
+    INTEGER (kind=il), INTENT (in) :: ktype     ! Type of projection
+    INTEGER (kind=il), INTENT (out) :: kerr     ! Error code
+    REAL (kind=rd), INTENT (out) :: px, py      ! Cartesian coordinates of projected point
+    REAL (kind=rd) :: zr, zlon, zlat, zlat0
+    INTEGER (kind=il) :: jn
+    !!
+    zlon = plon - plon0
+    DO jn = 1, 2
+      IF ( zlon >  180.0_rd) zlon = zlon - 360.0_rd
+      IF ( zlon < -180.0_rd ) zlon = zlon + 360.0_rd
+    END DO
+    zlon  = rad * zlon
+    zlat0 = rad * plat0
+    zlat  = rad * plat
+    kerr  = 0
+    !!
+    IF      ( ktype == 1 ) THEN ! Orthographic
+        px = COS(zlat ) * SIN(zlon)                   
+        py = COS(zlat0) * SIN(zlat) - SIN(zlat0) * COS(zlat) * COS(zlon)
+    ELSE IF ( ktype == 2 ) THEN ! Lambert Equal Area
+        zr = SIN (zlat0) * SIN(zlat) + COS(zlat0) * COS(zlat) * COS(zlon)
+        IF ( zr <= -1.0 ) THEN 
+            kerr = 1
+            RETURN
+        END IF
+        zr = SQRT ( 2.0_rd / ( 1.0_rd + zr ) )
+        px = zr * COS (zlat) * SIN(zlon)
+        py = zr * ( COS(zlat0) * SIN(zlat) - SIN(zlat0) * COS(zlat) * COS(zlon) )
+    END IF
+    !!
+    RETURN
+    !!
+  END SUBROUTINE proj
+END MODULE mod_proj
+
Index: /TOOLS/MOZAIC/src/MOZAIC/readw.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/readw.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/readw.f90	(revision 3326)
@@ -0,0 +1,41 @@
+! -*- Mode: f90 -*-
+PROGRAM readw
+!!
+  IMPLICIT NONE
+  CHARACTER (len = 8) :: cl
+  INTEGER ( kind = 4) :: ji, jpi, ios
+  INTEGER ( kind = 4) :: nw = 14, nout = 6
+  REAL (kind = 4) :: zz
+  INTEGER ( kind = 4) :: ii
+  !!
+  OPEN ( unit = nw, file = 'mozaic.w', form = 'unformatted', action = 'read', status = 'old', position = 'rewind' )
+  jpi = MAX ( 182 * 149 , 96 * 48 ) * MAX ( 8, 25 ) * 2
+  !!
+  READ ( unit = nw) cl
+  WRITE ( unit = nout, fmt = *) cl
+  READ ( unit = nw, ERR = 101 )  ( ii, ji = 1, jpi )
+101 CONTINUE
+  WRITE ( unit = nout, fmt = *) ji-1
+  !!
+  ji = 1
+  READ ( unit = nw) cl
+  WRITE ( unit = nout, fmt = *) cl
+  READ ( unit = nw, ERR = 201 ) ( zz, ji = 1, jpi )
+201 CONTINUE
+  WRITE ( unit = nout, fmt = *) ji-1
+  !!
+  ji = 1
+  READ ( unit = nw) cl
+  WRITE ( unit = nout, fmt = *) cl
+  READ ( unit = nw, ERR = 301 )  ( ii, ji = 1, jpi )
+301 CONTINUE
+  WRITE ( unit = nout, fmt = *) ji-1
+  !!
+  ji = 1
+  READ ( unit = nw) cl
+  WRITE ( unit = nout, fmt = *) cl
+  READ ( unit = nw, IOSTAT = ios)  ( zz, ji = 1, jpi )
+  WRITE ( unit = nout, fmt = *) ji-1
+  !!
+  STOP
+END PROGRAM readw
Index: /TOOLS/MOZAIC/src/MOZAIC/rectifie.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/rectifie.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/rectifie.f90	(revision 3326)
@@ -0,0 +1,106 @@
+! -*- Mode: f90 -*-
+MODULE mod_rectifie
+CONTAINS
+   SUBROUTINE rectifie
+      !> Correction de quelques elements
+      !!
+      USE declare
+      USE modeles
+      USE mod_lbc
+      USE formula
+      USE mod_prih
+      !!
+      IMPLICIT NONE
+      INTEGER (kind=il)  :: joi, joj, jai, jaj
+      REAL (kind=rl) :: zxc, zyc, ztc, zrc, zlonc, zlatc, zarea, zs_n, zs_s
+      REAL (kind=rl), DIMENSION (:), ALLOCATABLE :: zx, zy, zt, zr       !> Dummies for polar projection
+      INTEGER (kind=il) :: ierr
+      !!
+      ALLOCATE (zx (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zs in rectifie')
+      ALLOCATE (zy (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zy in rectifie')
+      ALLOCATE (zt (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zt in rectifie')
+      ALLOCATE (zr (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zr in rectifie')
+      !!
+      WRITE (nout,*) 'Debut rectifie'
+      !!
+      !! Cheat for surface (only for LMD5) 
+      SELECT CASE (TRIM(camod))
+      CASE ('lmd5')
+         xasrft = 4.0_rl * rpi * ra * ra / REAL (jpan, kind = rl)
+      CASE ('lmdz')
+         !!
+         IF ( la_pole ) THEN
+            !! One point cover all around the poles
+            IF (xasrft(m1a(1_il,1_il)) < xasrft(m1a(1_il,2_il)) ) THEN 
+               zs_n = 0.0_rl ; zs_n = 0.0_rl
+               DO jai = 1, jpai
+                  zs_s = zs_s + xasrft(m1a(jai,1_il))
+                  zs_n = zs_n + xasrft(m1a(jai,jpaj))
+               ENDDO
+               DO jai = 1, jpai
+                  xasrft(m1a(jai,1_il)) = zs_s
+                  xasrft(m1a(jai,jpaj)) = zs_n
+               ENDDO
+            ENDIF
+         END IF
+      END SELECT
+      !!
+
+      !! Find size of earth 
+      ra = DOT_PRODUCT (xasrft, REAL (1-iamskp, kind=rl ))
+      WRITE (UNIT=nout, FMT="('surface from xasrft', 1E12.3)" ) ra
+      ra = SQRT (ra / (4.0_rl * rpi))
+      WRITE (nout, *) "Earth radius (km): ", ra / 1000.0_rl
+      WRITE (nout, fmt = '("Raw surfaces ocean, atm : ", 2(1PE15.3)) ' ) SUM (xosrft), SUM (xasrft)
+      !!
+      !! Ocean southernmost grid box (masked anyway) is extended up to South Pole
+      ! Cheat for surface of these boxes
+      zarea = ra * ra * rpi * (1.0_rl - SIN(rad * ABS(xolatu (jpoi+1))))
+      xosrft (1: jpoi) = zarea / REAL(jpoi-2, KIND = rl)
+      WRITE (nout, fmt = '("surface ocean 1 : ", 1PE15.3)' )  DOT_PRODUCT (xosrft, REAL(1-iomskp,kind=rl))
+      !!
+      !! Ocean : last grid box (in 2nd dimension) is extended up to the pole of the grid.
+      !!
+      ! Position of grid 'pole' 
+      zt    = xolonv * rad
+      zr    = 2.0 * TAN (rad * (45.0 - xolatv / 2.0 ) )
+      zx    = zr * COS (zt) ; zy  = zr * SIN (zt)
+      zxc   = SUM (zx (jpon - jpoi + 2: jpon - 1)) / REAL (jpoi - 2, kind = rl)
+      zyc   = SUM (zy (jpon - jpoi + 2: jpon - 1)) / REAL (jpoi - 2, kind = rl)
+      zrc   = SQRT (zxc**2 + zyc**2 )
+      ztc   = ATAN2 (zyc, zxc)
+      zlonc = ztc / rad
+      zlatc = 90.0 - ATAN (zrc) / rad
+      !
+      WRITE (unit = nout, fmt = *) 'Center for ocean : ', zlonc, zlatc
+      !
+!-$$    IF ( cotyp(1:4) == 'orca' ) THEN 
+!-$$       xolonv (jpon - jpoi + 1: jpon) = zlonc
+!-$$       xolonf (jpon - jpoi + 1: jpon) = zlonc
+!-$$       xolatv (jpon - jpoi + 1: jpon) = zlatc
+!-$$       xolatf (jpon - jpoi + 1: jpon) = zlatc
+!-$$       WRITE (unit = nout, fmt = *) 'Set grid pole'
+!-$$       ! Compute surface of modified boxes
+!-$$       zarea = 4.0 * rpi * ra * ra - SUM (xosrft (1: jpon - jpoi - 1) * REAL (iomskp (1: jpon - jpoi - 1), kind=rl)  )
+!-$$       xosrft (jpon - jpoi + 1: jpon) = zarea / REAL (jpoi - 2, kind = rl)
+!-$$       WRITE (nout, fmt = '("surface ocean 2 : ", 1PE15.3)' )  SUM (xosrft)
+!-$$    END IF
+      !!
+      !! Normalize surface (to the surface of a sphere with radius 1)
+      !!
+      zarea = 4.0_rl * ra * ra * rpi
+      !$$$  xosrft = xosrft / zarea
+      !$$$  xasrft = xasrft / zarea
+      !!
+      xsurfa = SUM (xasrft)
+      xsurfo = DOT_PRODUCT (xosrft, REAL(1-iomskp, kind=rl) )
+      WRITE (unit = nout, fmt = '("Surface atmos         : ", 1PE20.6)' ) xsurfa
+      WRITE (unit = nout, fmt = '("Surface ocean         : ", 1PE20.6)' ) xsurfo
+      xsurfa = DOT_PRODUCT (xasrft, REAL ((1-iamskt)*(1-iamskp), kind=rl) )
+      xsurfo = DOT_PRODUCT (xosrft, REAL ((1-iomskt)*(1-iomskp), kind=rl) ) 
+      WRITE (unit = nout, fmt = '("Surface atmos (masked): ", 1PE20.6)' ) xsurfa
+      WRITE (unit = nout, fmt = '("Surface ocean (masked): ", 1PE20.6)' ) xsurfo
+      !!
+      RETURN
+   END SUBROUTINE rectifie
+END MODULE mod_rectifie
Index: /TOOLS/MOZAIC/src/MOZAIC/time.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/time.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/time.f90	(revision 3326)
@@ -0,0 +1,349 @@
+! -*- Mode: f90 -*-
+!!! 
+!!! lecture d'un fichier NetCDF et interpolation
+!!! en temps 
+!!! Modifiez le module 'modele' selon votre cas de figure
+!!!
+MODULE declare_2
+   !!
+   USE defprec
+   IMPLICIT NONE
+   !! Data types
+   INTEGER, PARAMETER :: r4 = r_4, r8 = r_8, i4 = i_4, i8 = i_8
+   INTEGER, PARAMETER :: rl = r_std, il = i_std
+   INTEGER (kind=il), PARAMETER :: nout = 6 ! Fichier de sortie des messages
+   REAL (kind=r8) :: rpi = 3.141592653589_rl
+   !!
+END MODULE declare_2
+!!
+MODULE modele_2
+  USE declare_2
+  IMPLICIT NONE
+  CHARACTER (len=80) :: cfile_in = 'AMIP_7d_SSTICE_grid_T_nomask.nc' ! Fichier d'entree
+  CHARACTER (len=80) :: cfile_ou = 'AMIP_1d_SSTICE_grid_T_nomask.nc' ! Fichier sortie
+  INTEGER (kind=il), PARAMETER :: jpt1 =  52 ! Dimension temps en entrée
+  INTEGER (kind=il), PARAMETER :: jpt2 = 360 ! Dimension temps en sortie
+  INTEGER (kind=il), PARAMETER :: jpi = 92, jpj = 76, jpk = 1 ! Dimension modele
+  INTEGER (kind=il), PARAMETER :: jpdim =  4 ! Nombre maxi de dimensions
+  INTEGER (kind=il), PARAMETER :: jpvar = 30 ! Nombre maxi de variables
+  REAL (kind=r8) :: zfreeze = -1.77_r8 ! Point de congélation
+  !
+END MODULE modele_2
+!!
+PROGRAM time
+   USE declare_2
+   USE modele_2
+   USE fliocom
+   USE errioipsl
+   IMPLICIT NONE
+   !! 
+   REAL (kind=r8), DIMENSION (jpi*jpj*jpk*jpt1) :: zvar_in8
+   REAL (kind=r8), DIMENSION (jpi*jpj*jpk*jpt2) :: zvar_ou8
+   REAL (kind=r8), DIMENSION (jpt1) :: time1
+   REAL (kind=r8), DIMENSION (jpt2) :: time2
+   INTEGER (kind=il), DIMENSION ( jpdim) :: dim_len1, dim_len2
+   CHARACTER (len=20), DIMENSION ( jpdim) :: cldim
+   INTEGER (kind=il) :: jdim, jvar
+   INTEGER (kind=il), DIMENSION ( jpvar) :: xtype, ndims, natts
+   CHARACTER (len=20), DIMENSION ( jpvar) :: clvar
+   CHARACTER (len=20) :: cname
+   CHARACTER (len=20), DIMENSION (1) :: catt
+   INTEGER (kind=il), DIMENSION ( jpvar, jpdim) :: dimsid
+   INTEGER (kind=il) :: ji, jt, jd, jv, ja, jnt, tid, xid, yid, zid
+   INTEGER (kind=il) :: ncid_in, ncid_ou, len1, len2
+   CHARACTER (len=8) :: c8
+   INTEGER (kind=il), DIMENSION ( jpdim) :: istart1, istart2, icount1, icount2
+   LOGICAL :: l_ex
+   !!
+   !! Ouverture fichier entree
+   CALL flioopfd (TRIM(cfile_in), ncid_in, nb_dim=jdim, nb_var=jvar, nb_gat=natts(1))
+   !! Dimensions
+   CALL flioinqf (ncid_in, ln_dim=dim_len1(1:jdim))
+   CALL flioinqn (ncid_in, cn_dim=cldim(1:jdim))
+   SeekDim: DO jd = 1, jdim
+      WRITE ( unit = c8, fmt = '(1I8)' ) jd
+      SELECT CASE ( dim_len1(jd))
+      CASE ( jpi)
+         dim_len2 (jd) = jpi
+      CASE ( jpj )
+         dim_len2 (jd) = jpj
+      CASE ( jpk)
+         dim_len2 (jd) = jpk
+      CASE default
+         dim_len2 (jd) = dim_len1 (jd)
+      END SELECT
+      ! Determination du nombre de pas de temps
+      jnt = 0
+      WRITE(unit=c8,fmt='(2I4)') jd
+      IF ( INDEX ( cldim(jd), 'time') /= 0 .OR. INDEX ( cldim(jd), 'TIME') /= 0 .OR. INDEX ( cldim(jd), 'Time') /= 0) THEN 
+         jnt = dim_len1(jd) ; tid = jd ; dim_len2 (jd) = -1 ! Unlimited
+      END IF
+      IF ( INDEX ( cldim(jd), 'X') /= 0 .OR. INDEX ( cldim(jd), 'x') /= 0 ) xid = jd 
+      IF ( INDEX ( cldim(jd), 'Y') /= 0 .OR. INDEX ( cldim(jd), 'y') /= 0 ) yid = jd 
+      IF ( INDEX ( cldim(jd), 'deptht') /= 0 )  zid = jd 
+   END DO SeekDim
+   WRITE ( nout, *) 'Nombre de dimensions : ', jdim
+   WRITE ( nout, *) 'Longueur temps       : ', jnt
+   IF ( jnt /= jpt1) THEN 
+      WRITE(nout,*) 'Erreur sur nombre de pas de temps en entree '
+      STOP
+   END IF
+   !! Ouverture fichier sortie
+   CALL fliocrfd ( TRIM(cfile_ou), cldim(1:jdim), dim_len2(1:jdim), ncid_ou)
+   !!
+   !! Attributs globaux
+   DO ja = 1, natts (1) 
+      WRITE ( unit = c8, fmt = '(2I4)' ) ja
+      CALL flioinqn (ncid_in, ia_start=ja, ia_count=1, cn_gat=catt ) ; cname=catt(1)
+      CALL fliocpya (ncid_in, '?', cname, ncid_ou, '?' )
+   END DO
+
+   !
+   !! Definition variables
+   SeekVar: DO jv = 1, jvar
+      CALL flioinqv (ncid_in, TRIM(clvar(jv)), l_ex, nb_atts=natts(jv), v_t=xtype(jv), nb_dims=ndims(jv))
+      CALL flioinqv (ncid_in, TRIM(clvar(jv)), l_ex, id_dims=dimsid(jv,1:ndims(jv)))
+      WRITE ( nout, FMT='(1A20,8I5)' ) TRIM(clvar(jv)), xtype(jv), dimsid(jv,1:ndims(jv)), natts(jv), jv
+      IF ( INDEX ( clvar(jv), 'time') /= 0 .OR. INDEX ( clvar(jv), 'TIME') /= 0 .OR. &
+         & INDEX ( clvar(jv), 'Time') /= 0) tid = jv
+      CALL fliodefv (ncid_ou, TRIM(clvar(jv)), dimsid(jv,1:ndims(jv)), v_t=xtype(jv))
+      !! Traitements des attributs
+      DO ja = 1, natts(jv)
+         WRITE ( unit = c8, fmt = '(2I4)' ) jv, ja
+         CALL flioinqv (ncid_in, TRIM(clvar(jv)), l_ex, ia_start=ja, ia_count=1, cn_atts=catt) ; cname=catt(1)
+         CALL fliocpya (ncid_in, TRIM(clvar(jv)), cname, ncid_ou, TRIM(clvar(jv)) )
+      END DO
+   END DO SeekVar
+   !!
+   Var: DO jv = 1, jvar
+      WRITE(unit=c8,fmt='(2I4)') jv
+      istart1 = 1 ; icount1 = 1 ; istart2 = 1 ; icount2 = 1
+      SELECT CASE ( ndims(jv) )
+      CASE (1)
+         IF      ( jv == tid ) THEN 
+            istart1 (1)= 1 ; icount1 (1) = jpt1 ; istart2 (1) = 1 ; icount2 (1) = jpt2
+         ELSE IF ( jv == xid ) THEN
+            istart1 (1) = 1 ; icount1 (1) = jpi ; istart2 (1) = 1 ; icount2 (1) = jpi
+            IF ( jt > 1) CYCLE var
+         ELSE IF ( jv == yid ) THEN 
+            istart1 (1) = 1 ; icount1 (1) = jpj ; istart2 (1) = 1 ; icount2 (1) = jpj
+            IF ( jt > 1) CYCLE var
+         ELSE IF ( jv == zid ) THEN 
+            istart1 (1) = 1 ; icount1 (1) = jpk ; istart2 (1) = 1 ; icount2 (1) = jpk
+            IF ( jt > 1) CYCLE var
+         ELSE
+            IF ( jt > 1) CYCLE var
+         END IF
+      CASE ( 2) 
+         IF ( jt > 1 ) CYCLE var
+         istart1 (1:2) = (/  1, 1 /) ; icount1 (1:2) = (/jpi, jpj /)
+         istart2 (1:2) = (/  1, 1 /) ; icount2 (1:2) = (/jpi, jpj /)
+      CASE ( 3) 
+         istart1 (1:3) = (/  1, 1, 1 /) ; icount1 (1:3) = (/jpi, jpj, jpt1 /)
+         istart2 (1:3) = (/  1, 1, 1 /) ; icount2 (1:3) = (/jpi, jpj, jpt2 /)
+      CASE ( 4) 
+         istart1 (1:4) = (/  1, 1, 1, 1 /) ; icount1 (1:4)  = (/jpi, jpj, jpk, jpt1 /)
+         istart2 (1:4) = (/  1, 1, 1, 1 /) ; icount2 (1:4)  = (/jpi, jpj, jpk, jpt2 /)
+      END SELECT
+      !!
+      len1 = product ( icount1 ) ; len2 = product ( icount2 )
+      WRITE ( nout, *) TRIM(clvar(jv)), " ", jv, ndims(jv), len1, len2, xtype(jv)
+      !
+      ! Lecture
+      CALL fliogetv (  ncid_in, TRIM(clvar(jv)), zvar_in8(1:len1), istart1, icount1)
+      !
+      WRITE (nout,*) 'extrema entree : ', MINVAL ( zvar_in8(1:len1)) , MAXVAL ( zvar_in8(1:len1))
+      ! Interpolation en temps
+      IF ( jv == xid .OR. jv == yid .OR. jv == zid) THEN 
+         zvar_ou8(1:len1) = zvar_in8(1:len1)
+      ELSE IF ( jv == tid ) THEN
+         time1 = zvar_in8(1:len1)
+         DO jt = 1, jpt2
+            time2 ( jt) = REAL ( jt, kind = r8) * 86400 * 360_r8 / REAL ( jpt2,r8)
+         END DO
+         zvar_ou8(1:len2) = time2
+!$$$          WRITE (nout,*) 'time1 : ', time1
+!$$$          WRITE (nout,*) 'time2 : ', time2
+      ELSE
+         CALL inter ( zvar_in8(1:len1), zvar_ou8(1:len2))
+         IF ( INDEX ( clvar(jv), 'ice') /= 0 .OR. INDEX ( clvar(jv), 'ICE') /= 0  )  THEN 
+            zvar_ou8(1:len2) = MIN ( 1.0_r8, MAX ( 0.0_r8, zvar_ou8(1:len2)))
+         END IF
+      END IF
+      WRITE (nout,*) 'extrema sortie : ', MINVAL ( zvar_ou8(1:len2)) , MAXVAL ( zvar_ou8(1:len2))
+      ! Ecriture
+      IF ( ndims(jv) == 3 ) THEN 
+         DO jt = 1, jpt2
+            istart2 (1:3) = (/  1, 1, jt /) ; icount2 (1:3) = (/jpi, jpj, 1 /)
+            CALL flioputv (ncid_ou, TRIM(clvar(jv)), zvar_ou8(jpi*jpj*(jt-1)+1:jpi*jpj*jt), &
+               & istart2(1:ndims(jv)), icount2(1:ndims(jv)) )
+         END DO
+      ELSE IF ( ndims(jv) == 4 ) THEN 
+         DO jt = 1, jpt2
+            istart2 (1:4) = (/  1, 1, 1, jt /) ; icount2 (1:4) = (/jpi, jpj, jpk, 1 /)
+            CALL flioputv (ncid_ou, TRIM(clvar(jv)), zvar_ou8(jpi*jpj*jpk*(jt-1)+1:jpi*jpj*jpk*jt), &
+               & istart2(1:ndims(jv)), icount2(1:ndims(jv)) )
+         END DO
+      ELSE
+         CALL flioputv( ncid_ou, TRIM(clvar(jv)), zvar_ou8(1:len2),  &
+            & istart2(1:ndims(jv)), icount2(1:ndims(jv)) )
+      END IF
+   END DO Var
+   !!
+   CALL flioclo( ncid_in)
+   CALL flioclo( ncid_ou)
+   !!
+   STOP
+CONTAINS
+   SUBROUTINE inter ( pin, pou )
+      USE declare_2
+      USE modele_2
+      IMPLICIT NONE
+      REAL (kind=r8), INTENT (  in), DIMENSION ( :) :: pin
+      REAL (kind=r8), INTENT ( out), DIMENSION ( :) :: pou
+      REAL (kind=r8), DIMENSION (-1:jpt1+2) :: zz1, zzt, zz
+      INTEGER (kind=il) :: idim, jn1, jn2, jn, jt1, jt2
+      REAL (kind=r8) :: dt
+      !!
+      !! Interpolation en temps
+      ! Dimension spatiale
+      idim = SIZE ( pin) / jpt1
+      IF ( idim /= ( SIZE ( pou) / jpt2) ) STOP 001
+      ! WRITE (nout,*) 'idim : ', idim
+      IF ( jpt1 == jpt2 ) THEN 
+         pou = pin
+         !!
+      ELSE IF ( jpt1 == 2 ) THEN 
+         ! On suppose que l'on a les valeurs de fevrier et d'aout
+         ! On fait passer un sinus entre ces deux valeurs, en conservant la moyenne pour ces deux mois
+         DO jt2 = 1, jpt2  ! nouvel indice 
+            DO ji = 1, idim
+               jn1 = ji + idim * ( 1 - 1)
+               jn2 = ji + idim * ( 2 - 1)
+               jn  = ji + idim * ( jt2 - 1)
+               pou (jn)= (  ( pin(jn1) + pin(jn2) ) * 360_r8 / REAL(jpt2,r8) ) / 60_r8   & 
+                  & +  ( pin(jn1) - pin(jn2) ) * ( COS ( ( 360_r8*REAL(jt,r8)/REAL(jpt2,r8) - 135_r8 ) * rpi /180_r8 ) &
+                  & - COS ( ( 360_r8*REAL(jt-1,r8)/REAL(jpt2,r8) - 135_r8 ) * rpi /180_r8 ) ) / 2_r8  &
+                  & * ( COS ( 75_r8 * rpi / 180_r8 ) - COS ( 105_r8 * rpi / 180_r8 ) )
+            END DO
+         END DO
+      ELSE  IF ( jpt2 > jpt1 ) THEN ! Spline cubique
+         dt = time1(2)-time1(1)
+         DO ji = 1, idim
+            zzt(1:jpt1) = time1 ; zzt(0) = zzt(1)-dt ; zzt(-1) = zzt(0)-dt
+            zzt(jpt1+1) = zzt(jpt1)+dt ; zzt(jpt1+2) = zzt(jpt1+1)+dt
+            DO jt1 = 1, jpt1
+               zz1 (jt1) = pin (ji+idim*(jt1-1)) 
+            END DO
+            zz1(0) = zz1 (jpt1) ; zz1(-1) = zz1(jpt1-1) ; zz1 (jpt1+1) = zz1(1) ; zz1(jpt1+2) = zz1(2)
+            CALL spline ( zzt, zz1, jpt1+2, zz)
+            DO jt2 = 1, jpt2
+               CALL splint ( zzt, zz1, zz, jpt1+2, time2(jt2), pou(ji+idim*(jt2-1)) )
+            END DO
+         END DO
+!$$$    ELSE IF ( jpt2 > jpt1 ) THEN ! Lineaire
+!$$$        dt = time1(2)-time1(1)
+!$$$        DO jt2 = 1, jpt2
+!$$$          IF      ( time2(jt2) .LE. time1(1) ) THEN 
+!$$$              jt1 = 1 ; jt1p = jpt1
+!$$$              z1 = -( time1(1) - time2(jt2)) / dt
+!$$$          ELSE IF ( time2(jt2) .GE. time1(jpt1) ) THEN 
+!$$$              jt1 = jpt1 ; jt1p = 1
+!$$$              z1 = -( time1(jt1) - time2(jt2)) / dt
+!$$$          ELSE
+!$$$              DO jt1 = 1, jpt1-1
+!$$$                IF ( time1(jt1) .LE. time2(jt2) .AND. time1(jt1+1) .GT. time2(jt2) ) EXIT
+!$$$              END DO
+!$$$              jt1p = jt1+1
+!$$$              z1 = ( time2(jt2) - time1(jt1)) / dt
+!$$$          END IF
+!$$$          z2 = 1.0_r8 - z1
+!$$$          DO ji = 1, idim
+!$$$            jn1 = ji + idim * ( jt1  - 1) ; jn2 = ji + idim * ( jt1p - 1) ; jn  = ji + idim * ( jt2  - 1)
+!$$$            pou(jn) = z1 * pin(jn1) + z2 * pin(jn2)
+!$$$          END DO
+!$$$        END DO
+      END IF
+   END SUBROUTINE inter
+   SUBROUTINE spline ( x, y, n, y2, yp1, ypn)
+      ! Routine to set up the interpolating function for a cubic spline
+      ! interpolation (see "Numerical Recipes" for details).
+      USE declare_2
+      IMPLICIT NONE
+      INTEGER (kind=il) :: n
+      REAL (kind=r8), DIMENSION (n), INTENT (in) :: x, y
+      REAL (kind=r8), INTENT (in), OPTIONAL :: yp1, ypn ! First derivative
+      REAL (kind=r8), DIMENSION (n), INTENT (out) :: y2
+      REAL (kind=r8), DIMENSION (n) :: u
+      REAL (kind=r8) :: un, qn, sig, p
+      INTEGER (kind=il) :: i, k
+      !
+      IF ( PRESENT ( yp1) ) THEN 
+         ! have a specified first derivative 
+         y2(1)=-0.5_r8
+         u(1)=(3./(x(2)-x(1)))*((y(2)-y(1))/(x(2)-x(1))-yp1)
+      ELSE 
+         ! the lower boundary condition is set to be "natural"
+         y2(1)=0.0_r8 ; u(1)=0.0_r8
+      END IF
+      !
+      DO i=2,n-1
+         ! decomposition loop of the tridiagonal algorithm. Y2 and U are used
+         ! for temporary storage of the decomposed factors
+         sig   = (x(i)-x(i-1))/(x(i+1)-x(i-1))
+         p     = sig*y2(i-1)+2.0_r8
+         y2(i) = (sig-1.)/p
+         u(i)  = (6.0_r8*((y(i+1)-y(i))/(x(i+1)-x(i))-(y(i)-y(i-1))/(x(i)-x(i-1)))/(x(i+1)-x(i-1))-sig*u(i-1))/p
+      END DO
+      !
+      IF ( PRESENT ( ypn) ) THEN 
+         ! Have a specified first derivative
+         qn = 0.50_r8
+         un = (3.0_r8/(x(n)-x(n-1)))*(ypn-(y(n)-y(n-1))/(x(n)-x(n-1)))
+      ELSE 
+         ! the upper boundary condition is set to be "natural"
+         qn = 0.0_r8 ; un = 0.0_r8
+      END IF
+      !
+      y2(n) = (un-qn*u(n-1))/(qn*y2(n-1)+1.0_r8)
+      !
+      DO k = n-1,1,-1
+         ! this is the backsubstitution loop of the tridiagonal algorithm
+         y2(k) = y2(k)*y2(k+1)+u(k)
+      END DO
+      RETURN
+   END SUBROUTINE spline
+   SUBROUTINE splint ( xa, ya, y2a, n, x, y)
+      ! Routine to compute a cubic-spline interpolated value Y given the
+      ! value of X, the arrays XA, YA and the 2nd derivative array Y2A
+      ! computed by SUBROUTINE SPLINE. See "Numerical Recipes" for details
+      USE declare_2
+      IMPLICIT NONE
+      INTEGER (kind=il) :: n
+      REAL (kind=r8), INTENT (  in) :: x
+      REAL (kind=r8), INTENT ( out) :: y
+      REAL (kind=r8), INTENT ( in), DIMENSION(n) :: xa, ya, y2a
+      INTEGER (kind=il) :: kl0, khi, k
+      REAL (kind=r8) :: h, a, b
+      !
+      kl0=1; khi=n
+      ! means of bisection
+      DO WHILE (khi-kl0.GT.1)
+         k = (khi+kl0)/2
+         IF(xa(k) .GT. x) THEN
+            khi=k
+         ELSE
+            kl0=k
+         END IF
+      END DO
+      ! KL0 and KHI now bracket the X
+      h=xa(khi)-xa(kl0)
+      IF(h .eq. 0.0_r8) STOP
+      a=(xa(khi)-x)/h
+      ! evaluation of cubic spline polynomial
+      b=(x-xa(kl0))/h
+      y=a*ya(kl0)+b*ya(khi)+((a**3-a)*y2a(kl0)+(b**3-b)*y2a(khi))*(h**2)/6.
+      !
+      RETURN
+   END SUBROUTINE splint
+END PROGRAM time
Index: /TOOLS/MOZAIC/src/MOZAIC/tst_field.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/tst_field.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/tst_field.f90	(revision 3326)
@@ -0,0 +1,385 @@
+! -*- Mode: f90 -*-
+PROGRAM tst_field
+!!! -------------------------------------------------------------------------------
+!!! Tests des poids pour OASIS 2, Mozaic
+!!! Adapte a LMD5 et OPA
+!!! -------------------------------------------------------------------------------
+   !!
+   !! 1) Lit les fichiers de masques, grilles et surfaces des deux modeles
+   !! 2) Lit fichier de poids
+   !! 3) Lance une série de test
+   !!
+   !! --------------------------------------------------------------------------------
+   !! LMCE, CEA-Saclay
+   !! --------------------------------------------------------------------------------
+   !!
+   USE declare
+   USE modeles
+   USE mod_locio
+   USE fliocom
+   USE errioipsl
+   USE formula
+   USE mod_lbc
+   USE mod_inter
+   USE mod_lecdata
+   USE mod_inipar
+   !!
+   IMPLICIT NONE
+   !!
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: zoce, zo        ! Champ ocean
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: zatm, za        ! Champ atmosphere
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: zaoce           ! Fraction d'ocean dans la maille atmosphere
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iaoce
+   LOGICAL :: l_run = .FALSE.
+   LOGICAL :: l_land = .FALSE.
+   LOGICAL :: l_bord = .FALSE.
+   LOGICAL, DIMENSION (:), ALLOCATABLE :: lacot, laland
+   REAL (kind=rl) :: bila, bilo
+   REAL (kind=rd) :: zzd
+   CHARACTER (len=1) :: cw_wei = '2'
+   CHARACTER (LEN=3) :: lsens
+   CHARACTER (LEN=20) :: clarg
+   REAL (kind=rl) :: y_lat_min, y_lat_max
+   CHARACTER (LEN=1) :: c_lat_min, c_lat_max
+   INTEGER :: narg
+   !INTEGER, EXTERNAL :: iargc
+   !!
+   CHARACTER (len = 15) :: clo = 'oce.nc', cla = 'atm.nc'
+   INTEGER (kind = i_4) :: nco, nca
+   CHARACTER (len = 14) :: ctitle
+   !!
+   INTEGER (kind=il) :: ja, jo, jn, joi, joj, jai, jaj, ierr
+   INTEGER, PARAMETER :: jpn = 34
+   !! Initialisation
+   !CALL ipsldbg (.TRUE. )
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13; nchk = 16 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 81 ; nwei8o2a = 82 ; nwei4a2o = 83 ; nwei8a2o = 84
+   !!
+   CALL inipar
+   CALL alloc_modeles
+   !!
+   ALLOCATE (zoce   (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zoce', lreset=.TRUE., crout='tstmosaic')
+   ALLOCATE (zo     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zo')
+   ALLOCATE (zatm   (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'zatm')
+   ALLOCATE (za     (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'za')
+   ALLOCATE (zaoce  (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'zaoce')
+   ALLOCATE (iaoce  (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'iaoce')
+   ALLOCATE (lacot  (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'lacot')
+   ALLOCATE (laland (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'laland')
+   !!
+   lwra2o = .FALSE. ; lwro2a = .TRUE.
+   !!
+   narg = iargc ()
+   DO ja = 1, narg
+      CALL getarg (ja, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE ('-r')
+         WRITE (UNIT=nout, FMT=*) 'Runoff case'
+         l_run = .TRUE.
+         cw_wei = '3'
+         jma2o = jma2or
+      CASE ('-R')
+         l_run = .FALSE.
+      CASE ('-2') ; 
+         cw_wei = '2'
+      CASE ('-3') ; 
+         cw_wei = '3'
+         jma2o = jma2or
+      CASE ('-4') ;
+         cw_wei = '4'
+         jma2o = jma2or
+      CASE ('-5') ; 
+         cw_wei = '5'
+         jma2o = jma2oi
+      CASE ('-l') ;
+         l_land = .TRUE.
+      CASE ('-L') ;
+         l_land = .FALSE.
+      CASE ('-b')
+         l_bord = .TRUE.
+      CASE ('-B')
+         l_bord = .FALSE.
+      END SELECT
+   END DO
+   !!
+   !! Diag
+   !!
+   !! Fichiers de diagnostics
+   !!
+   OPEN (unit = nchk, file = 'tests.out', position = 'REWIND', action = 'write', status = 'replace' )
+   !!
+   !! Lecture des coordonnees
+   !!
+   CALL lecdata (lecweights = .TRUE., leco2amask = .TRUE., cw_num=cw_wei)
+   !!
+   nva = COUNT (mask = (ko2a /= 0), DIM = 1)
+   nvo = COUNT (mask = (ka2o /= 0), DIM = 1)
+   WRITE (nout, *) 'MAX nva nvo ', MAXVAL(nva), MAXVAL (nvo)
+   WRITE (nout, *) 'MIN et MAX ko2a ', MINVAL (ko2a), MAXVAL (ko2a)
+   WRITE (nout, *) 'MIn et MAX ka2o ', MINVAL (ka2o), MAXVAL (ka2o)
+   !!
+   IF (MAXVAL (ko2a) .GT. jpon) WRITE (nout,*) 'Erreur :  MAXVAL (ko2a) .GT. jpon '
+   IF (MINVAL (ko2a) .LT. 0   ) WRITE (nout,*) 'Erreur :  MINVAL (ko2a) .LT. 0   '
+   IF (MAXVAL (ka2o) .GT. jpan) WRITE (nout,*) 'Erreur :  MAXVAL (ka2o) .GT. jpan '
+   IF (MINVAL (ka2o) .LT. 0   ) WRITE (nout,*) 'Erreur :  MINVAL (ka2o) .LT. 0   '
+   !!
+   !! Periodicity masks
+   iomskp = 0_il
+   IF (noperio == 1_il .OR. noperio == 4_il ) THEN 
+      DO joj = 1, jpoj ! Periodical edge set to zero to suppress double points for ocean
+         iomskp (m1o (1_il, joj)) = 1_il
+         iomskp (m1o (jpoi, joj)) = 1_il
+      END DO
+   END IF
+   IF (noperio == 1_il .OR. noperio == 4_il) THEN 
+      ! Supress duplicate points due to the North fold
+      DO joi = 1, jpoi
+         iomskp (m1o (joi, jpoj  ) ) = 1_il
+      END DO
+      DO joi = jpoi/2+2, jpoi
+         iomskp (m1o (joi, jpoj-1) ) = 1_il
+      END DO
+   ENDIF
+   !
+   iamskp = 0_il
+   IF (naperio == 1_il .OR. naperio == 4_il ) THEN 
+      DO jaj = 1, jpaj ! Periodical edge set to zero to suppress double points for atm
+         iamskp (m1a (1_il, jaj)) = 1_il
+         iamskp (m1a (jpai, jaj)) = 1_il
+      END DO
+   END IF
+   IF (naperio == 1 .OR. naperio == 4) THEN 
+      ! Supress duplicate points due to the North fold
+      DO jai = 1, jpai
+         iamskp (m1a (jai, jpaj  ) ) = 1_il
+      END DO
+      DO jai = jpai/2+2, jpai
+         iamskp (m1a (joi, jpaj-1) ) = 1_il
+      END DO
+   ENDIF
+   !!
+   !! Ecriture des champs dans un fichier NetCDF
+   !! Open file for ocean
+   CALL fliocrfd (TRIM(clo), (/ 'x', 'y'/), (/jpoi, jpoj/), nco, mode='REPLACE')
+   ! Quelques attributs globaux
+   CALL flioputa (nco, '?', 'Conventions', 'COARDS')
+   !
+   CALL fliodefv (nco, 'omask'  , (/1_il, 2_il/), v_t=flio_i1)
+   !
+   CALL flioputv (nco, 'omask'  , RESHAPE(iomskt ,(/jpoi, jpoj/)) )
+   !!
+   !! Open file for atmosphere
+   CALL fliocrfd (TRIM(cla), (/ 'x', 'y'/), (/jpai, jpaj/), nca, mode='REPLACE')
+   ! Quelques attributs globaux
+   CALL flioputa (nca, '?', 'Conventions', 'COARDS')
+   !
+   CALL fliodefv (nca, 'o2amask', (/1_il, 2_il/), v_t=flio_r4)
+   CALL fliodefv (nca, 'amask'  , (/1_il, 2_il/), v_t=flio_i1)
+   !
+   CALL flioputv (nca, 'amask'  , RESHAPE(iamskt ,(/jpai, jpaj/)) )
+   CALL flioputv (nca, 'o2amask', RESHAPE(o2amask,(/jpai, jpaj/)) )
+   !!
+   CALL inter_o2a (REAL (1-iomskt, kind = rl), zaoce) 
+   iaoce = 1
+   WHERE (zaoce .GT. 0) iaoce = 0
+   !!
+   !! Point cotier Atm
+   lacot = .FALSE.
+   WHERE (o2amask .GT. epsfrac .AND. o2amask .LT. (1.0_rl-epsfrac) ) lacot = .TRUE.
+   laland = .FALSE.
+   WHERE (o2amask .LT. (1.0_rl-epsfrac) ) laland = .TRUE.
+   !!
+   !! Verif normalisation
+   !$$$  DO ja = 1, jpan
+   !$$$     zzd = SUM (REAL (wo2a(:,ja), rd) )
+   !$$$     IF (zzd /= 0.0_rd .AND. zzd < 1.0_rd-epsfrac .OR. zzd > 1.0_rd ) THEN 
+   !$$$        WRITE (unit=nout, fmt = '("Pb with normalisation o2a: ", 1I8, 2(1PE15.5))' ) &
+   !$$$           ja, zzd, zzd-1.0_rd
+   !$$$     END IF
+   !$$$  END DO
+   !$$$  !!
+   !$$$  DO jo = 1, jpon
+   !$$$     zzd = SUM (REAL (wa2o(:,jo), rd) )
+   !$$$     IF (zzd /= 0.0_rd .AND. zzd < 1.0_rd-epsfrac .OR.  zzd > 1.0_rd ) THEN 
+   !$$$        WRITE (unit=nout, fmt = '("Pb with normalisation a2o: ", 1I8, 2(1PE15.5))' ) &
+   !$$$           jo, zzd, zzd-1.0_rd
+   !$$$     END IF
+   !$$$  END DO
+   !!
+   !! Verifs ocean vers atmosphere
+   WRITE (UNIT=nout, FMT=*)   '    Nom               Int. Atm      Int. oce   Erreur'
+
+   ctitle = '              '
+   LoopCase: DO jn = 1, jpn-1
+      !WRITE (UNIT=nout, FMT=*) jn
+      SELECT CASE (jn)
+      CASE (1_il) ! Oceanic field = constant
+         zoce = 1.0_rl ; zatm = 0.0_rl
+         CALL lbc (zoce, noperio, 'T', jpoi, jpoj)
+         CALL inter_o2a (zoce, zatm)
+         ctitle = 'Oce_constant' ; lsens='o2a'
+      CASE (2_il) ! Atm field = constant
+         zatm = 1.0_rl ; zoce = 0.0_rl
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         CALL inter_a2o (zatm, zoce)
+         ctitle = 'Atm_constant' ; lsens = 'a2o'
+      CASE (3_il) ! Oceanic field = masked constant
+         zoce = REAL (1-iomskt, kind = rl)
+         zatm = 0.0_rl
+         CALL inter_o2a (zoce, zatm)
+         ctitle = 'Oce_masked' ; lsens='o2a'
+      CASE (4_il) ! Atm field = masked constant
+         zatm = REAL (1-iaoce, kind = rl)
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         zoce = 0.0_rl
+         CALL inter_a2o (zatm, zoce)
+         ctitle = 'Atm_masked' ; lsens = 'a2o'
+      CASE (5_il) ! Oceanic field = latitude
+         zoce = ABS(xolatt) * REAL (1-iomskt, kind = rl)
+         CALL lbc (zoce, noperio, 'T', jpoi, jpoj)
+         zatm = 0.0_rl
+         CALL inter_o2a (zoce, zatm)
+         ctitle = 'Oce_lat' ; lsens='o2a'
+      CASE (6_il) ! Atm field = latitude
+         zatm = ABS(xalatt) * REAL (1-iaoce, kind = rl)
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         zoce = 0.0_rl
+         CALL inter_a2o (zatm, zoce)
+         ctitle = 'Atm_lat' ; lsens = 'a2o'
+      CASE (7_il) ! Oceanic field = longitude
+         zoce = COS (rad*xolont)**2 * REAL (1-iomskt, kind = rl)
+         CALL lbc (zoce, noperio, 'T', jpoi, jpoj)
+         zatm = 0.0_rl
+         CALL inter_o2a (zoce, zatm)
+         ctitle = 'Oce_lon' ; lsens='o2a'
+      CASE (8_il) ! Atm field = longitude
+         zatm = COS (rad*xalont)**2 * REAL (1-iaoce, kind = rl)
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         zoce = 0.0_rl
+         CALL inter_a2o (zatm, zoce)
+         ctitle = 'Atm_lon' ; lsens = 'a2o'
+      CASE (9_il) ! Oceanic field = COS(longitude) * latitude
+         zoce = ABS(xolatt) * COS (rad*xolont)**2 * REAL (1-iomskt, kind = rl)
+         CALL lbc (zoce, noperio, 'T', jpoi, jpoj)
+         zatm = 0.0_rl
+         CALL inter_o2a (zoce, zatm)
+         ctitle = 'Oce_lonxlat' ; lsens='o2a'
+      CASE (10_il) ! Atm field = longitude * latitude
+         zatm = COS (rad*xalont)**2 * ABS(xalatt) * REAL (1-iaoce, kind = rl)
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         zoce = 0.0_rl
+         CALL inter_a2o (zatm, zoce)
+         ctitle = 'Atm_lonxlat' ; lsens = 'a2o'
+      CASE (11_il) ! Atm field = random
+         CALL RANDOM_NUMBER (zatm)
+         zatm = zatm * REAL (1-iaoce, kind = rl)
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         zoce = 0.0_rl
+         CALL inter_a2o (zatm, zoce)
+         ctitle = 'Atm_random' ; lsens = 'a2o'
+      CASE (12_il) ! Oce field = random
+         CALL RANDOM_NUMBER (zoce)
+         zoce = zoce * REAL (1-iomskt, kind = rl)
+         zatm = 0.0_rl
+         CALL inter_o2a (zoce, zatm)
+         ctitle = 'Oce_random' ; lsens='o2a' 
+      CASE Default ! Oce field = bande de latitude
+         IF ( MOD (jn,2) == 0 ) THEN 
+            y_lat_min = REAL( (jn-13)/2,rl)*10.0 - 70.0_rl
+            y_lat_max = y_lat_min + 10.0_rl
+            c_lat_min='S' ; c_lat_max='S'
+            IF ( y_lat_min >= 0.0_rl ) c_lat_min = 'N'
+            IF ( y_lat_max >= 0.0_rl ) c_lat_max = 'N'
+            zoce = 0.0_rl
+            WHERE ( xolatt .GE. y_lat_min .AND. xolatt .LE. y_lat_max ) zoce = 1.0_rl
+            zoce = zoce * REAL (1-iomskt, kind = rl)
+            zatm = 0.0_rl
+            CALL inter_o2a (zoce, zatm)
+            !WRITE (UNIT=nout  , FMT=*) INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+            !WRITE (UNIT=nout  , FMT='("Oce_", 1I2.2, 1A, "_", 1I2.2, 1A)') INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+            WRITE (UNIT=ctitle, FMT='("Oce_", 1I2.2, 1A, "_", 1I2.2, 1A)') INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+            lsens='o2a'
+         ELSE
+            y_lat_min = REAL( (jn-13)/2,rl)*10.0 - 70.0_rl
+            y_lat_max = y_lat_min + 10.0_rl
+            c_lat_min='S' ; c_lat_max='S'
+            IF ( y_lat_min >= 0.0_rl ) c_lat_min = 'N'
+            IF ( y_lat_max >= 0.0_rl ) c_lat_max = 'N'
+            zatm = 0.0_rl
+            WHERE ( xalatt .GT. y_lat_min .AND. xalatt .LT. y_lat_max ) zatm = 1.0_rl
+            zatm = zatm * REAL (1-iaoce, kind = rl)
+            zoce = 0.0_rl
+            CALL inter_a2o (zatm, zoce)
+            !WRITE (UNIT=nout  , FMT=*) INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+            !WRITE (UNIT=nout  , FMT='("Oce_", 1I2.2, 1A, "_", 1I2.2, 1A)') INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+            WRITE (UNIT=ctitle, FMT='("Atm_", 1I2.2, 1A, "_", 1I2.2, 1A)') INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+            lsens='a2o'
+         ENDIF
+      CASE (jpn) ! 
+         WRITE (nout, *) 'Bilan a -> o'
+         zatm = 0.0_rl
+         DO ja = 1, jpan
+            IF ( iaoce (ja) == 0 ) THEN 
+               za = 0.0_rl ; zo = 0.0_rl
+               za (ja) = 1.0_rl
+               CALL inter_a2o (za, zo)
+               zatm (ja) = za (ja) * o2amask (ja) - DOT_PRODUCT (zo, xosrft) / xasrft (ja) 
+            END IF
+         END DO
+         !
+         WRITE (nout, *) 'Bilan o -> a'
+         zoce = 0.0_rl
+         DO jo = 1, jpon 
+            IF ( iomskt (jo) == 0 ) THEN 
+               zo = 0.0_rl ; za = 0.0_rl
+               zo (jo) = 1.0_rl
+               CALL inter_o2a (zo, za)
+               zoce (jo) = zo (jo) - DOT_PRODUCT (za, xasrft * o2amask) / xosrft (jo)  
+            END IF
+         END DO
+         ctitle = 'Bilan'
+      END SELECT
+      !!
+      SELECT CASE (lsens) 
+      CASE ('a2o')
+         IF (l_run) THEN
+            bila = DOT_PRODUCT (zatm     , REAL((1-iamskp)*(1-iamskt),kind=rl))
+         ELSE
+            bila = DOT_PRODUCT (zatm*xasrft*o2amask, REAL((1-iamskp)*(1-iamskt),kind=rl))
+         END IF
+      CASE ('o2a')
+         bila = DOT_PRODUCT (zatm*xasrft*o2amask, REAL((1-iamskp)*(1-iamskt),kind=rl))
+      END SELECT
+      bilo = DOT_PRODUCT (zoce*xosrft, REAL((1-iomskp)*(1-iomskt),kind=rl))
+      !
+      WRITE (nout, FMT= '(1I3, 1A14, "  ", 2(1PE12.2, "  "), "  ", 1PE8.2)' ) jn, TRIM (ctitle), bila, bilo, ABS((bila-bilo)/(bila+bilo))*2.0_rl
+      CALL fliodefv (nco, TRIM (ctitle), (/1, 2/), v_t=flio_r4)
+      !CALL flioputa (nco, TRIM (ctitle), 'missing_value', 0.0_r4)
+      !
+      CALL fliodefv (nca, TRIM(ctitle), (/1, 2/), v_t=flio_r4)
+      !CALL flioputa (nca, TRIM(ctitle), 'missing_value', 0.0_r4)
+      !
+      CALL flioputv (nco, TRIM (ctitle), RESHAPE (zoce, (/jpoi, jpoj/)) ) 
+      CALL flioputv (nca, TRIM (ctitle), RESHAPE (zatm, (/jpai, jpaj/)) ) 
+      !!
+   END DO LoopCase
+   !!
+   CALL flioclo (nco) 
+   CALL flioclo (nca)
+   !!
+   STOP
+   !!
+END PROGRAM tst_field
+!!
Index: /TOOLS/MOZAIC/src/MOZAIC/tst_prec.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/tst_prec.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/tst_prec.f90	(revision 3326)
@@ -0,0 +1,11 @@
+! 
+PROGRAM tst_prec
+      
+   INTEGER, PARAMETER :: rl = 8
+      
+   WRITE(UNIT=6,fmt='("facteurs corrections ", 3(1PE23.15) )' ) &
+      & 1.0_rl, 2.0_rl*EPSILON(1.0_rl), 1.0_rl-2.0_rl*EPSILON(1.0_rl)
+   
+   
+   STOP
+END PROGRAM tst_prec
Index: /TOOLS/MOZAIC/src/MOZAIC/tstmosaic.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/tstmosaic.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/tstmosaic.f90	(revision 3326)
@@ -0,0 +1,308 @@
+! -*- Mode: f90 -*-
+PROGRAM tstmosaic
+!!! -------------------------------------------------------------------------------
+!!! Tests des poids pour OASIS 2, Mozaic
+!!! Adapte a LMD5 et OPA
+!!! -------------------------------------------------------------------------------
+   !!
+   !! 1) Lit les fichiers de masques, grilles et surfaces des deux modeles
+   !! 2) Lit fichier de poids
+   !! 3) Lance une série de test
+   !!
+   !! --------------------------------------------------------------------------------
+   !! LMCE, CEA-Saclay
+   !! --------------------------------------------------------------------------------
+   !!
+   USE declare
+   USE modeles
+   USE mod_locio
+   USE fliocom
+   USE errioipsl
+   USE formula
+   USE mod_lbc
+   USE mod_inter
+   USE mod_lecdata
+   USE bords
+   USE mod_inipar
+   !!
+   IMPLICIT NONE
+   !!
+   INTEGER (kind=il), PARAMETER :: jpn = 16 ! Nombre de tests d'interpolation
+   INTEGER (kind=il) :: jpfirst = 8 ! Premier test avec bandes latitudes
+   !!
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: zoce, zo        ! Champ ocean
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: zatm, za        ! Champ atmosphere
+   REAL (kind=rl)   , DIMENSION (:), ALLOCATABLE :: zaoce           ! Fraction d'ocean dans la maille atmosphere
+   INTEGER (kind=il), DIMENSION (:), ALLOCATABLE :: iaoce
+   LOGICAL :: l_run = .FALSE.
+   LOGICAL :: l_land = .FALSE.
+   LOGICAL :: l_bord = .FALSE.
+   REAL (kind=rl) :: bila, bilo
+   REAL (kind=rd) :: zzd
+   CHARACTER (len=1) :: cw_wei = '2'
+   CHARACTER (LEN=3) :: lsens
+   CHARACTER (LEN=20) :: clarg
+   REAL (kind=rl) :: y_lat_min, y_lat_max
+   CHARACTER (LEN=1) :: c_lat_min, c_lat_max
+   INTEGER :: narg
+   !INTEGER, EXTERNAL :: iargc
+   !!
+   CHARACTER (len = 64) :: clout
+   INTEGER (kind = i_4) :: ncout
+   CHARACTER (len = 14) :: ctitle
+   !!
+   INTEGER (kind=il) :: ja, jo, jn, joi, joj, jai, jaj, ierr, jlat, jplat
+   REAL (kind=rl) :: dy, y_inf, y_sup
+   !! Initialisation
+   !CALL ipsldbg (.TRUE. )
+   ngrd = 11 ; nsrf = 12 ; nmsk = 13; nchk = 16 ; ndeb = 9 ; nbug1 = 10
+   nwei4o2a = 81 ; nwei8o2a = 82 ; nwei4a2o = 83 ; nwei8a2o = 84
+   !!
+   CALL inipar
+   CALL alloc_modeles
+   !!
+   ALLOCATE (zoce   (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zoce', lreset=.TRUE., crout='tstmosaic')
+   ALLOCATE (zo     (jpon), STAT=ierr) ; CALL chk_allo (ierr, 'zo')
+   ALLOCATE (zatm   (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'zatm')
+   ALLOCATE (za     (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'za')
+   ALLOCATE (zaoce  (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'zaoce')
+   ALLOCATE (iaoce  (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'iaoce')
+   ALLOCATE (lacot  (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'lacot')
+   ALLOCATE (laland (jpan), STAT=ierr) ; CALL chk_allo (ierr, 'laland')
+   !!
+   lwra2o = .FALSE. ; lwro2a = .TRUE.
+   !!
+   narg = iargc ()
+   DO ja = 1, narg
+      CALL getarg (ja, clarg)
+      SELECT CASE (TRIM(clarg))
+      CASE ('-r')
+         WRITE (UNIT=nout, FMT=*) 'Runoff case'
+         l_run = .TRUE.
+         cw_wei = '3'
+         jma2o = jma2or
+         lsens = 'a2o'
+      CASE ('-R')
+         l_run = .FALSE.
+      CASE ('-2') ; 
+         cw_wei = '2'
+      CASE ('-3') ; 
+         cw_wei = '3'
+         jma2o = jma2or
+      CASE ('-4') ;
+         cw_wei = '4'
+         jma2o = jma2or
+      CASE ('-5') ; 
+         cw_wei = '5'
+         jma2o = jma2oi
+      CASE ('-l') ;
+         l_land = .TRUE.
+      CASE ('-L') ;
+         l_land = .FALSE.
+      CASE ('-b')
+         l_bord = .TRUE.
+      CASE ('-B')
+         l_bord = .FALSE.
+      CASE ('-o')
+         lsens = 'o2a'
+      CASE ('-a')
+         lsens = 'a2o'
+      END SELECT
+   END DO
+   !!
+   !! Diag
+   !!
+   !! Fichiers de diagnostics
+   !!
+   OPEN (unit = nchk, file = 'tests.out', position = 'REWIND', action = 'write', status = 'replace' )
+   !!
+   !! Lecture des coordonnees
+   !!
+   CALL lecdata (lecweights = .TRUE., leco2amask = .TRUE., cw_num=cw_wei)
+   CALL bord_a
+   CALL bord_o
+   CALL bord_oa
+   !!
+   nva = COUNT (mask = (ko2a /= 0), DIM = 1)
+   nvo = COUNT (mask = (ka2o /= 0), DIM = 1)
+   WRITE (nout, *) 'MAX nva nvo ', MAXVAL(nva), MAXVAL (nvo)
+   WRITE (nout, *) 'MIN et MAX ko2a ', MINVAL (ko2a), MAXVAL (ko2a)
+   WRITE (nout, *) 'MIN et MAX ka2o ', MINVAL (ka2o), MAXVAL (ka2o)
+   !!
+   IF (MAXVAL (ko2a) .GT. jpon) WRITE (nout,*) 'Erreur :  MAXVAL (ko2a) .GT. jpon '
+   IF (MINVAL (ko2a) .LT. 0   ) WRITE (nout,*) 'Erreur :  MINVAL (ko2a) .LT. 0   '
+   IF (MAXVAL (ka2o) .GT. jpan) WRITE (nout,*) 'Erreur :  MAXVAL (ka2o) .GT. jpan '
+   IF (MINVAL (ka2o) .LT. 0   ) WRITE (nout,*) 'Erreur :  MINVAL (ka2o) .LT. 0   '
+   !!
+   !! Ecriture des champs dans un fichier NetCDF
+   clout = 'tstmosaic_' // TRIM (lsens)
+   CALL fliocrfd (TRIM(clout), (/ 'xa', 'ya', 'xo', 'yo'/), (/jpai, jpaj, jpoi, jpoj/), ncout, mode='REPLACE')
+   ! Quelques attributs globaux
+   CALL flioputa (ncout, '?', 'Conventions', 'COARDS')
+   !
+   CALL fliodefv (ncout, 'o2amask' , (/1_il, 2_il/), v_t=flio_r4)
+   CALL fliodefv (ncout, 'amask'   , (/1_il, 2_il/), v_t=flio_i1)
+   CALL fliodefv (ncout, 'tlmd_lon', (/1_il, 2_il/), v_t=flio_r4)
+   CALL fliodefv (ncout, 'tlmd_lat', (/1_il, 2_il/), v_t=flio_r4)
+   !
+   CALL fliodefv (ncout, 'omask'   , (/3_il, 4_il/), v_t=flio_i1)
+   CALL fliodefv (ncout, 'torc_lon', (/3_il, 4_il/), v_t=flio_r4)
+   CALL fliodefv (ncout, 'torc_lat', (/3_il, 4_il/), v_t=flio_r4)
+   !
+   CALL flioputv (ncout, 'omask'   , RESHAPE(iomskt ,(/jpoi, jpoj/)) )
+   CALL flioputv (ncout, 'torc_lon', RESHAPE(xolont ,(/jpoi, jpoj/)) )
+   CALL flioputv (ncout, 'torc_lat', RESHAPE(xolatt ,(/jpoi, jpoj/)) )
+   !
+   CALL flioputv (ncout, 'amask'   , RESHAPE(iamskt ,(/jpai, jpaj/)) )
+   CALL flioputv (ncout, 'o2amask' , RESHAPE(o2amask,(/jpai, jpaj/)) )
+   CALL flioputv (ncout, 'tlmd_lon', RESHAPE(xalont ,(/jpai, jpaj/)) )
+   CALL flioputv (ncout, 'tlmd_lat', RESHAPE(xalatt ,(/jpai, jpaj/)) )
+   !!
+   CALL inter_o2a (REAL (1-iomskt, kind = rl), zaoce) 
+   iaoce = 1
+   WHERE (zaoce .GT. 0) iaoce = 0
+   !!
+   !! Point cotier Atm
+   lacot = .FALSE.
+   WHERE (o2amask .GT. epsfrac .AND. o2amask .LT. (1.0_rl-epsfrac) ) lacot = .TRUE.
+   laland = .FALSE.
+   WHERE (o2amask .LT. (1.0_rl-epsfrac) ) laland = .TRUE.
+   !!
+   jplat = jpn-jpfirst
+   y_inf = MAX (-90.1_rl, MIN( yo_inf, ya_inf ) - 2.0_rl)
+   y_sup = MIN ( 90.1_rl, MAX (yo_sup, ya_sup ) + 2.0_rl)
+   dy = (y_sup-y_inf)/REAL(jplat+1,rl)
+   WRITE (nout,*) 'y_inf, y_suf, dy ; ', y_inf, y_sup, dy
+
+   !! Verifs 
+   WRITE (UNIT=nout, FMT=*)   '    Nom               Int. Atm      Int. oce   Erreur'
+   ctitle = ' '
+   LoopCase: DO jn = 1, jpn
+      !WRITE (UNIT=nout, FMT=*) jn
+      IF ( lsens == 'o2a' ) THEN
+         SELECT CASE (jn)
+         CASE (1_il) ! Oceanic field = constant
+            zoce = 1.0_rl ; zatm = 0.0_rl
+            ctitle = 'Oce_constant'
+         CASE (2_il) ! Oceanic field = masked constant
+            zoce = REAL (1-iomskt, kind = rl)
+            ctitle = 'Oce_masked'
+         CASE (3_il) ! Oceanic field = latitude
+            zoce = ABS(xolatt) * REAL (1-iomskt, kind = rl)
+            ctitle = 'Oce_lat'
+         CASE (4_il) ! Oceanic field = longitude
+            zoce = 2.0_rl + COS (rad*xolont)**2 * REAL (1-iomskt, kind = rl)
+            ctitle = 'Oce_lon'
+         CASE (5_il) ! Oceanic field = COS(longitude) * latitude
+            zoce = 2.0_rl + ABS(xolatt) * COS (rad*xolont)**2 * REAL (1-iomskt, kind = rl)
+            ctitle = 'Oce_lonxlat'
+         CASE (6_il) ! Oce field = random
+            CALL RANDOM_NUMBER (zoce)
+            zoce = 1.0_rl + zoce * REAL (1-iomskt, kind = rl)
+            ctitle = 'Oce_random'
+         CASE (7_il) ! Oce field = 1 point
+            zoce = 0.0_rl 
+            zoce (jpon/2)  = 1.0_rl
+            ctitle = 'Oce_point'
+         CASE Default ! Oce field = bande de latitude
+            jlat  = jn-jpfirst
+            y_lat_min = REAL( jlat,rl)*dy + y_inf
+            y_lat_max = y_lat_min + dy
+            !WRITE (nout,*) jn, jlat, y_lat_min, y_lat_max
+            c_lat_min='S' ; c_lat_max='S'
+            IF ( y_lat_min >= 0.0_rl ) c_lat_min = 'N'
+            IF ( y_lat_max >= 0.0_rl ) c_lat_max = 'N'
+            zoce = 0.0_rl
+            WHERE ( xolatt .GE. y_lat_min .AND. xolatt .LE. y_lat_max ) zoce = 1.0_rl
+            zoce = zoce * REAL (1-iomskt, kind = rl)
+            WRITE (UNIT=ctitle, FMT='("Oce_", 1I2.2, 1A, "_", 1I2.2, 1A)') &
+               & INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+         END SELECT
+
+         CALL lbc (zoce, noperio, 'T', jpoi, jpoj)
+         zatm (:) = 0.0_rl
+         CALL inter_o2a (zoce, zatm)
+
+      END IF
+      IF ( lsens == 'a2o' ) THEN 
+         SELECT CASE (jn)
+         CASE (1_il) ! Atm field = constant
+            zatm = 1.0_rl
+            ctitle = 'Atm_constant'
+         CASE (2_il) ! Atm field = masked constant
+            zatm = REAL (1-iaoce, kind = rl)
+            ctitle = 'Atm_masked'
+         CASE (3_il) ! Atm field = latitude
+            zatm = ABS(xalatt) * REAL (1-iaoce, kind = rl)
+            ctitle = 'Atm_lat'
+         CASE (4_il) ! Atm field = longitude * latitude
+            zatm= 2.0_rl + COS (rad*xalont)**2 * ABS(xalatt) * REAL (1-iaoce, kind = rl)
+            ctitle = 'Atm_lonxlat'
+         CASE (5_il) ! Atm field = longitude
+            zatm = 2.0_rl + COS (rad*xalont)**2 * REAL (1-iaoce, kind = rl)
+            ctitle = 'Atm_lon'
+         CASE (6_il) ! Atm field = random
+            CALL RANDOM_NUMBER (zatm)
+            zatm = 1.0_rl + zatm * REAL (1-iaoce, kind = rl)
+            ctitle = 'Atm_random'
+         CASE (7_il) ! Atm field = 1 point
+            zatm = 0.0_rl
+            zatm (1:jpan/2) = 1.0_rl
+            ctitle = 'Atm_north'
+         CASE Default ! Oce field = bande de latitude
+            jlat  = jn-jpfirst
+            y_lat_min = REAL( jlat,rl)*dy + y_inf
+            y_lat_max = y_lat_min + dy
+            c_lat_min='S' ; c_lat_max='S'
+            IF ( y_lat_min >= 0.0_rl ) c_lat_min = 'N'
+            IF ( y_lat_max >= 0.0_rl ) c_lat_max = 'N'
+            zatm = 0.0_rl
+            WHERE ( xalatt .GT. y_lat_min .AND. xalatt .LT. y_lat_max ) zatm = 1.0_rl
+            zatm = zatm * REAL (1-iaoce, kind = rl)
+            zoce = 0.0_rl
+            WRITE (UNIT=ctitle, FMT='("Atm_", 1I2.2, 1A, "_", 1I2.2, 1A)') &
+               & INT(ABS(y_lat_min)), c_lat_min, INT(ABS(y_lat_max)), c_lat_max
+         END SELECT
+
+         IF (l_land) WHERE (.NOT. laland) zatm = 0.0_rl
+         IF (l_bord) WHERE (.NOT. lacot ) zatm = 0.0_rl
+         CALL lbc (zatm, naperio, 'T', jpai, jpaj)
+         CALL inter_a2o (zatm, zoce)
+
+      END IF
+      !!
+      SELECT CASE (lsens) 
+      CASE ('a2o')
+         IF (l_run) THEN
+            bila = DOT_PRODUCT (zatm     , REAL((1-iamskp)*(1-iamskt),kind=rl))
+         ELSE
+            bila = DOT_PRODUCT (zatm*xasrft*o2amask, REAL((1-iamskp)*(1-iamskt),kind=rl))
+         END IF
+      CASE ('o2a')
+         bila = DOT_PRODUCT (zatm*xasrft*o2amask, REAL((1-iamskp)*(1-iamskt),kind=rl))
+      END SELECT
+      bilo = DOT_PRODUCT (zoce*xosrft, REAL((1-iomskp)*(1-iomskt),kind=rl))
+      !
+      IF ( bila+bilo .EQ. 0.0_rl ) THEN 
+         WRITE (nout, FMT= '(1I3, 1A14, "  ", 2(1PE12.2, "  "), "  ", 1PE8.2)' ) &
+            & jn, TRIM (ctitle), bila, bilo
+      ELSE
+         WRITE (nout, FMT= '(1I3, 1A14, "  ", 2(1PE12.2, "  "), "  ", 1PE8.2)' ) &
+            & jn, TRIM (ctitle), bila, bilo, ABS((bila-bilo)/(bila+bilo))*2.0_rl
+      END IF
+      CALL fliodefv (ncout, TRIM (ctitle)//'_OCE', (/3, 4/), v_t=flio_r4)
+      !
+      CALL fliodefv (ncout, TRIM(ctitle)//'_ATM', (/1, 2/), v_t=flio_r4)
+      !
+      CALL flioputv (ncout, TRIM (ctitle)//'_OCE', RESHAPE (zoce, (/jpoi, jpoj/)) ) 
+      CALL flioputv (ncout, TRIM (ctitle)//'_ATM', RESHAPE (zatm, (/jpai, jpaj/)) ) 
+
+      !!
+   END DO LoopCase
+   !!
+   CALL flioclo (ncout) 
+   !!
+   STOP
+   !!
+END PROGRAM tstmosaic
+!!
Index: /TOOLS/MOZAIC/src/MOZAIC/util.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/util.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/util.f90	(revision 3326)
@@ -0,0 +1,23 @@
+! -*- Mode: f90 -*-
+MODULE mod_util
+CONTAINS
+   SUBROUTINE system_to_var ( c_command, c_result )
+      !
+      IMPLICIT NONE 
+      CHARACTER (len=*), INTENT (in)  :: c_command
+      CHARACTER (len=*), INTENT (out) :: c_result
+      !
+      CHARACTER (len=32) :: c_outfile = "system_command.tmp"
+      INTEGER :: i_unit=97
+      INTEGER, PARAMETER :: l_tmp = 256
+      CHARACTER (len=l_tmp) :: c_tmp
+      CHARACTER (len=8) :: c_format
+      !
+      CALL system (  TRIM (c_command ) // " > " // TRIM(c_outfile) )
+      OPEN (UNIT=i_unit, FILE=TRIM(c_outfile), FORM="FORMATTED", POSITION="REWIND", STATUS="OLD", ACTION="READ" )
+      WRITE (unit=c_format, FMT='("(A",1I3,")")' ) l_tmp
+      READ (UNIT=i_unit, FMT=c_format) c_result
+      CALL system ( "rm -f " // TRIM(c_outfile) )
+      !
+   END SUBROUTINE system_to_var
+END MODULE mod_util
Index: /TOOLS/MOZAIC/src/MOZAIC/wri_wei.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/wri_wei.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/wri_wei.f90	(revision 3326)
@@ -0,0 +1,892 @@
+! -*- Mode: f90 -*-
+MODULE mod_wri_wei
+   !> Set of routine to write weights and adresses
+   USE modeles
+   USE formula
+   USE fliocom
+   USE errioipsl
+
+   LOGICAL :: l_nor2sou
+   
+   INTERFACE atm_reshape
+      MODULE PROCEDURE atm_reshape_2d_r, atm_reshape_3d_r, atm_reshape_2d_i
+   END INTERFACE atm_reshape
+
+CONTAINS
+   
+   FUNCTION atm_reshape_2d_r ( ptab )
+      IMPLICIT NONE
+      REAL (kind=rl), DIMENSION (jpai, jpaj) :: atm_reshape_2d_r
+      REAL (kind=rl), INTENT (in), DIMENSION (jpan) :: ptab
+      INTEGER :: jai, jaj, jan, jaj_rev
+      
+      DO jaj = 1, jpaj
+         IF (l_nor2sou) THEN
+            jaj_rev = jpaj - jaj + 1
+         ELSE
+            jaj_rev = jaj
+         END IF
+         DO jai = 1, jpai
+            jan = jai + jpai * ( jaj_rev - 1)
+            atm_reshape_2d_r (jai, jaj) = ptab (jan)
+         END DO
+      END DO
+   END FUNCTION atm_reshape_2d_r
+   
+   FUNCTION atm_reshape_3d_r ( ptab )
+      IMPLICIT NONE
+      REAL (kind=rl), DIMENSION (jpai, jpaj, jpae) :: atm_reshape_3d_r
+      REAL (kind=rl), INTENT (in), DIMENSION (jpan, jpae) :: ptab
+      INTEGER :: jai, jaj, jan, jaj_rev
+      
+      DO jaj = 1, jpaj
+         IF (l_nor2sou) THEN
+            jaj_rev = jpaj - jaj + 1
+         ELSE
+            jaj_rev = jaj
+         END IF
+         DO jai = 1, jpai
+            jan = jai + jpai * ( jaj_rev - 1)
+            atm_reshape_3d_r (jai, jaj, :) = ptab (jan, :)
+         END DO
+      END DO
+   END FUNCTION atm_reshape_3d_r
+   
+   FUNCTION atm_reshape_2d_i ( ktab )
+      IMPLICIT NONE
+      INTEGER, DIMENSION (jpai, jpaj) :: atm_reshape_2d_i
+      INTEGER, INTENT (in), DIMENSION (jpan) :: ktab
+      INTEGER :: jai, jaj, jan, jaj_rev
+      
+      DO jaj = 1, jpaj
+         IF (l_nor2sou) THEN
+            jaj_rev = jpaj - jaj + 1
+         ELSE
+            jaj_rev = jaj
+         END IF
+         DO jai = 1, jpai
+            jan = jai + jpai * ( jaj_rev - 1)
+            atm_reshape_2d_i (jai, jaj) = ktab (jan)
+         END DO
+      END DO
+   END FUNCTION atm_reshape_2d_i
+   
+   SUBROUTINE wri_weights_o2a (cldiag_o2a, clw_o2a, clw_o2a_mct, clnum, l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac)
+      !> Write ocean -> atmosphere weights and adresses
+      IMPLICIT NONE
+      !!
+      CHARACTER (LEN=1), INTENT (in) :: clnum
+      CHARACTER (LEN=*), INTENT (in) :: cldiag_o2a, clw_o2a, clw_o2a_mct
+      LOGICAL, INTENT (in), OPTIONAL :: l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac
+      INTEGER (KIND=il) :: nco2a, ierr, num_links, num_wgts 
+      INTEGER (KIND=il) :: il_ncid
+      INTEGER (KIND=il) :: jai, jaj, ja, jo, j_link
+      INTEGER (KIND=il) :: jn, jw, i_var, i_stat, isize_max, isize, ideb, ifin, ja_deb, ja_fin, ja_inc
+      LOGICAL :: l_fd, l_src_grid_frac, l_dst_grid_frac
+      CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp
+      !!
+      REAL    (kind=rl), DIMENSION (:,:,:), ALLOCATABLE :: w_3d
+      INTEGER (kind=il), DIMENSION (:,:,:), ALLOCATABLE :: k_3d
+      !!
+      REAL    (kind=rl), DIMENSION (:,:), ALLOCATABLE :: w_mct
+      INTEGER (kind=il), DIMENSION (:)  , ALLOCATABLE :: k_src, k_dst
+      !
+      l_fd = .TRUE.
+      IF (PRESENT (l_fulldiag)) THEN 
+         l_fd = l_fulldiag
+      ELSE
+         !! Estimation de la taille des variables, limitation si > 2GB
+         i_var = jpoi * jpoj * jmo2a
+         IF ( i_var >= 2E9_il ) l_fd = .TRUE.
+      END IF
+      
+      IF ( PRESENT (lo_src_grid_frac) ) THEN
+         l_src_grid_frac = lo_src_grid_frac
+      ELSE
+          l_src_grid_frac = .TRUE.
+       END IF
+
+      IF ( PRESENT (lo_dst_grid_frac) ) THEN
+         l_dst_grid_frac = lo_dst_grid_frac
+      ELSE
+         l_dst_grid_frac = .TRUE.
+      END IF
+      
+      !!
+      !! Dataset ocean --> atmosphere
+      !!
+      clweight =  "WEIGHTS" // clnum ; cladress = "ADRESSE" // clnum
+      WRITE (unit = nout, fmt = *) " oce -> atm ", cladress, " ", clweight, " Neighbors : ", jmo2a
+      IF (c_oasis == '2.2' ) THEN
+         IF (l_wei_i4 .OR. l_wei_i8) WRITE (unit = nout, fmt = *) 'Ecriture o2a, fichiers binaires IEEE'
+         IF (l_wei_i4) THEN 
+            WRITE (UNIT = nwei4o2a) cladress
+            WRITE (UNIT = nwei4o2a) INT  (ko2a (1_il:jmo2a, 1_il:jpan), KIND=i_4 )
+            WRITE (UNIT = nwei4o2a) clweight
+            WRITE (UNIT = nwei4o2a) REAL (wo2a (1_il:jmo2a, 1_il:jpan), KIND=rk_out )
+         ENDIF
+         IF (l_wei_i8) THEN
+            WRITE (UNIT = nwei8o2a) cladress
+            WRITE (UNIT = nwei8o2a) INT  (ko2a (1_il:jmo2a, 1_il:jpan), KIND=i_8 )
+            WRITE (UNIT = nwei8o2a) clweight
+            WRITE (UNIT = nwei8o2a) REAL (wo2a (1_il:jmo2a, 1_il:jpan), KIND=rk_out )
+         ENDIF
+      ENDIF
+      IF (l_wei_i4) THEN 
+         WRITE (UNIT = nout, FMT = *) 'Ecriture OCEMASK i4r8 : non masque'
+         WRITE (UNIT = nwei4o2a) 'OCEMASK'//clnum
+         WRITE (UNIT = nout, FMT = *) 'Ecriture OCEMASK i4r8 : masque'
+         WRITE (UNIT = nwei4o2a) REAL (o2amask (1_il:jpan), KIND=rk_out )
+      END IF
+      IF (l_wei_i8) THEN
+         WRITE (UNIT = nout, FMT = *) 'Ecriture OCEMASK i8r8 : non masque'
+         WRITE (UNIT = nwei8o2a) 'OCEMASK'//clnum
+         WRITE (UNIT = nout, FMT = *) 'Ecriture i8r8 : masque'
+         WRITE (UNIT = nwei8o2a) REAL (o2amask (1_il:jpan), KIND=rk_out )
+         WRITE (UNIT = nout, FMT = *) 'Ecriture en binaire IEEE : fini '
+      ENDIF
+      !!
+      !! Output diagnostics in NetCDF file
+      !!
+      !CALL ipsldbg (new_status=.TRUE. )
+      WRITE (unit = nout, fmt = *) 'Ecriture o2a, diagnostiques ', TRIM(cldiag_o2a)
+      WRITE (unit = nout, fmt = *) 'Retournement nord/sud des champs : ', xalatt(1), xalatt(jpan), TRIM(o2a_orien)
+
+      IF (      TRIM(o2a_orien) .EQ. "nord_en_bas") THEN 
+         WRITE (unit = nout, fmt = *) "Cas nord_en_bas"
+         IF ( xalatt(1) .GT. xalatt(jpan) ) THEN 
+            l_nor2sou = .FALSE.
+            ja_deb =    1 ; ja_fin = jpaj ; ja_inc =  1
+         ELSE
+            l_nor2sou = .TRUE.
+            ja_deb = jpaj ; ja_fin =    1 ; ja_inc = -1
+         END IF
+      ELSE IF ( TRIM(o2a_orien) .EQ. "nord_en_haut") THEN 
+         WRITE (unit = nout, fmt = *) "Cas nord_en_haut"
+         IF ( xalatt(1) .GT. xalatt(jpan) ) THEN 
+            l_nor2sou = .TRUE.
+            ja_deb = jpaj ; ja_fin =    1 ; ja_inc = -1
+         ELSE
+            l_nor2sou = .FALSE.
+            ja_deb =    1 ; ja_fin = jpaj ; ja_inc =  1
+         END IF
+      ELSE
+         WRITE (unit = nout, fmt = *) "Cas inconnu"
+         l_nor2sou = .FALSE.
+         ja_deb =    1 ; ja_fin = jpaj ; ja_inc =  1
+      END IF
+
+      WRITE (unit = nout, fmt = *) 'Retournement nord/sud des champs : ', l_nor2sou, ja_deb, ja_fin, ja_inc
+
+      CALL fliocrfd (TRIM(cldiag_o2a) // TRIM(c_suffix), (/'x   ', 'y   ', 'n   ', 'edge'/), (/jpai, jpaj, jmo2a, jpae /),&
+         & nco2a, mode=c_FlioMode)
+      CALL fliopstc (nco2a, &
+         & x_axis_2d = atm_reshape(xalont), &
+         & y_axis_2d = atm_reshape(xalatt)  )
+      CALL flioputa (nco2a, '?', 'Comment', TRIM(c_comment) )
+      CALL fliodefv (nco2a, 'Weights_Max'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm max weights')
+      CALL flioputa (nco2a, 'Weights_Max'//clnum, 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'Neighbors'//clnum  , (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm Neighbors')
+      CALL flioputa (nco2a, 'Neighbors'//clnum, 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'Weights_Sum'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm sum weights')
+      CALL flioputa (nco2a, 'Weights_Sum'//clnum, 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'Mask', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm mask')
+      CALL flioputa (nco2a, 'Mask', 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'OceMask', (/1_il,2_il/), v_t=flio_r4, standard_name='Oce ->Atm OceMask')
+      CALL flioputa (nco2a, 'OceMask', 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'OceMask_int', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce ->Atm OceMask')
+      CALL fliodefv (nco2a, 'OceMask_ext', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce ->Atm OceMask')
+      CALL fliodefv (nco2a, 'LonEdge', (/1,2,4/), v_t=flio_r4)
+      CALL flioputa (nco2a, 'LonEdge', 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'LatEdge', (/1,2,4/), v_t=flio_r4) 
+      CALL flioputa (nco2a, 'LatEdge', 'missing_value', 0.0_rl)
+      IF (l_fd) THEN
+         WRITE (nout,*) 'Fichier Diagnostics '
+         CALL fliodefv (nco2a, 'Weights'//clnum, (/1,2,3/), v_t=flio_r4, standard_name='Oce -> Atm Weights')
+         CALL flioputa (nco2a, 'Weights'//clnum, 'missing_value', 0.0_rl)
+         CALL fliodefv (nco2a, 'Adresses'//clnum,(/1,2,3/), v_t=flio_i4, standard_name='Oce -> Atm Adresses')
+         CALL flioputa (nco2a, 'Adresses'//clnum, 'missing_value', 0.0_rl)
+         CALL fliodefv (nco2a, 'Index_I'//clnum, (/1,2,3/), v_t=flio_i4 )
+         CALL flioputa (nco2a, 'Index_I'//clnum, 'missing_value', 0.0_rl)
+         CALL fliodefv (nco2a, 'Index_J'//clnum, (/1_il,2_il,3_il/), v_t=flio_i4 )
+         CALL flioputa (nco2a, 'Index_J'//clnum, 'missing_value', 0.0_rl)
+      ELSE
+          WRITE (nout,*) 'Pas de fichier diagnostics '
+      END IF
+      CALL fliodefv (nco2a, 'MaskPer', (/1_il,2_il/), v_t=flio_i4 )
+      CALL flioputa (nco2a, 'MaskPer', 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'Surface', (/1,2/))
+      CALL flioputa (nco2a, 'Surface', 'missing_value', 0.0_rl)
+      CALL fliodefv (nco2a, 'SurfacePol', (/1,2/))
+      CALL flioputa (nco2a, 'SurfacePol', 'missing_value', 0.0_rl)
+      !!
+      CALL flioputv (nco2a, 'Weights_Max'//clnum, atm_reshape (MAXVAL(wo2a,DIM=1)) )
+      CALL flioputv (nco2a, 'Neighbors'//clnum,   atm_reshape (MAX(0_il, nva))     )
+      CALL flioputv (nco2a, 'Weights_Sum'//clnum, atm_reshape (SUM   (wo2a,DIM=1)) )
+      CALL flioputv (nco2a, 'Mask',               atm_reshape (1_il-iamskt)        )
+      CALL flioputv (nco2a, 'OceMask',            atm_reshape (o2amask)            )
+      CALL flioputv (nco2a, 'OceMask_int',        atm_reshape (o2amask_i_int)      )
+      CALL flioputv (nco2a, 'OceMask_ext',        atm_reshape (o2amask_i_ext)      )
+      CALL flioputv (nco2a, 'LonEdge',            atm_reshape (xa_ed)              )
+      CALL flioputv (nco2a, 'LatEdge',            atm_reshape (ya_ed)              )
+      CALL flioputv (nco2a, 'Surface',            atm_reshape (xasrft)             )
+      CALL flioputv (nco2a, 'SurfacePol',         atm_reshape (xasrft_pol)         )
+
+      IF (l_fd) THEN
+         ALLOCATE (w_3d(jpai, jpaj, jmo2a), STAT=ierr) 
+         CALL chk_allo (ierr, 'w_3d(jpai,jpaj,jmo2a)', lreset=.TRUE., crout='wri_wei_o2a')
+         ALLOCATE (k_3d(jpai, jpaj, jmo2a), STAT=ierr)
+         CALL chk_allo (ierr, 'k_3d(jpai,jpaj,jmo2a)')
+
+         DO jn = 1_il, jmo2a
+            DO jaj = 1_il, jpaj
+               DO jai = 1_il, jpai
+                  w_3d (jai, jaj, jn) = REAL(wo2a (jn, m1a(jai, jaj)), KIND=rl)
+                  k_3d (jai, jaj, jn) = INT (ko2a (jn, m1a(jai, jaj)), KIND=il)
+               END DO
+            END DO
+         END DO
+         IF (limit_stack) THEN 
+            DO jn = 1_il, jmo2a
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nco2a, 'Weights'//clnum, w_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) )
+            END DO
+         ELSE
+            CALL flioputv (nco2a, 'Weights'//clnum, w_3d(:,ja_deb:ja_fin:ja_inc,:) )
+         ENDIF
+         !!
+         IF  (limit_stack) THEN
+            DO jn = 1_il, jmo2a
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nco2a, 'Adresses'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) )
+            ENDDO
+         ELSE
+            CALL flioputv (nco2a, 'Adresses'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,:))
+         ENDIF
+         DEALLOCATE (w_3d)
+         !
+         k_3d = 0_il
+         DO jn = 1_il, jmo2a
+            DO jaj = 1_il, jpaj
+               DO jai = 1_il, jpai
+                  k_3d (jai, jaj, jn) = m2oi(ko2a(jn, m1a(jai, jaj)))
+               END DO
+            END DO
+         END DO
+         IF (limit_stack) THEN 
+            DO jn = 1_il, jmo2a
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nco2a, 'Index_I'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) )
+            ENDDO
+         ELSE
+            CALL flioputv (nco2a, 'Index_I'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,1:jmo2a)) 
+         ENDIF
+         k_3d = 0_il
+         DO jn = 1_il, jmo2a
+            DO jaj = 1_il, jpaj
+               DO jai = 1_il, jpai
+                  k_3d (jai, jaj, jn) = m2oj(ko2a(jn, m1a(jai, jaj)))
+               END DO
+            END DO
+         END DO
+         IF (limit_stack) THEN 
+            DO jn = 1_il, jmo2a
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nco2a, 'Index_J'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,jn), start=(/1_il,1_il,jn/) )
+            ENDDO
+         ELSE
+            CALL flioputv (nco2a, 'Index_J'//clnum, k_3d(:,ja_deb:ja_fin:ja_inc,1:jmo2a)) 
+         ENDIF
+         DEALLOCATE (k_3d)
+      ENDIF
+      !!
+      WRITE (unit=nout,fmt=*) 'Fin ecriture diagnostiques o2a '
+      CALL flioclo (nco2a)
+      !!
+      IF ( l_wei_oasis_3 ) THEN
+         !! Ecriture des poids au format NetCDF de OASIS, format OASIS 3
+         !! O -> A
+         WRITE (unit=nout,fmt=*) 'Ecriture poids o2a NetCDF OASIS 3'
+         CALL fliocrfd (TRIM(clw_o2a) // TRIM(c_suffix) // '.nc' , (/'jmo2a', 'jpan '/), (/jmo2a, jpan/), il_ncid, mode=c_FlioMode )
+         CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) )
+         CALL fliodefv (il_ncid, 'WEIGHTS'//clnum, (/1, 2/), v_t=flio_r )
+         CALL fliodefv (il_ncid, 'ADRESSE'//clnum, (/1, 2/), v_t=flio_i )
+         ! Write WEIGHTS
+         IF (limit_stack) THEN 
+            DO jn = 1, jmo2a
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wo2a(jn,:), start=(/jn, 1/), count=(/1,jpan/) )
+            END DO
+         ELSE
+            CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wo2a(1:jmo2a,:))
+         ENDIF
+         ! Write ADRESSE
+         IF (limit_stack) THEN 
+            DO jn = 1, jmo2a
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (il_ncid, 'ADRESSE'//clnum, ko2a(jn,:), start=(/jn, 1/), count=(/1,jpan/) )
+            END DO
+         ELSE
+            CALL flioputv (il_ncid, 'ADRESSE'//clnum, ko2a(1:jmo2a,:)) 
+         ENDIF
+         WRITE (unit=nout, fmt=*) 'Fin ecriture poids o2a NetCDF'
+         CALL flioclo (il_ncid)
+         !!
+         WRITE (unit=nout,fmt=*) 'Ecriture poids o2a NetCDF, format OASIS MCT'
+         num_links = jpan * jmo2a
+         num_wgts  = 1
+         ALLOCATE (w_mct(num_wgts,num_links), STAT=ierr) 
+         CALL chk_allo (ierr, 'w_mct(num_wgts,num_links)', lreset=.TRUE., crout='wri_wei_o2a')
+         ALLOCATE (k_src(num_links), STAT=ierr) 
+         CALL chk_allo (ierr, 'k_src(num_links)', lreset=.TRUE., crout='wri_wei_o2a')
+         ALLOCATE (k_dst(num_links), STAT=ierr) 
+         CALL chk_allo (ierr, 'k_dst(num_links)', lreset=.TRUE., crout='wri_wei_o2a')
+         !
+         j_link = 0
+         DO ja = 1, jpan
+            DO jn = 1, jmo2a
+               IF (  ko2a (jn, ja) /= 0 ) THEN
+                  j_link = j_link + 1
+                  k_dst (j_link)   = ja
+                  k_src (j_link)   = ko2a (jn, ja)
+                  w_mct (1,j_link) = wo2a (jn, ja) 
+               END IF
+            END DO
+         END DO
+         num_links = j_link
+
+      END IF
+      
+      IF ( l_wei_oasis_mct ) THEN
+         !! Ecriture des poids au format NetCDF de OASIS, format OASIS MCT
+         
+         CALL fliocrfd (TRIM(clw_o2a_mct) // TRIM(c_suffix), &
+            & (/'src_grid_size   ', 'dst_grid_size   ', 'src_grid_corners', 'dst_grid_corners'  , &
+            &   'src_grid_rank   ', 'dst_grid_rank   ', 'num_links       ', 'num_wgts        '/), &
+            & (/ jpon             , jpan              ,  4                ,  4                  , &
+            &    2                ,  2                ,  num_links        ,  num_wgts         /), &
+            & il_ncid, mode=c_FlioMode) 
+         CALL flioputa (il_ncid, "?", "title"         , TRIM(clw_o2a_mct) )
+         CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) )
+         CALL flioputa (il_ncid, "?", "normalization" , "none" )
+         CALL flioputa (il_ncid, "?", "map_method"    , "Conservative Remapping" )
+         CALL DATE_AND_TIME (c_date, c_time, c_zone )
+         CALL flioputa (il_ncid, "?", "history"       , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"//c_date(7:8) &
+            & //" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) )
+         CALL flioputa (il_ncid, "?", "conventions"   , "SCRIP" )
+         CALL flioputa (il_ncid, "?", "method"        , "MOSAIC" )
+         CALL flioputa (il_ncid, "?", "source_grid"   , "curvilinear" )
+         CALL flioputa (il_ncid, "?", "dest_grid"     , "curvilinear" )
+         CALL flioputa (il_ncid, "?", "Institution"   , "IPSL" )
+         CALL flioputa (il_ncid, "?", "Model"         , "IPSL CM6" )
+         CALL flioputa (il_ncid, "?", "Max_nei_num"   , jmo2a )
+         CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat)
+         IF ( i_stat == 0 ) THEN
+            CALL flioputa (il_ncid, "?", "HOSTNAME"     , TRIM(c_tmp) )
+         ELSE 
+            WRITE (nout,*) 'Environment variable not found : $HOSTNAME'
+         END IF
+         CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat)
+         IF ( i_stat == 0 ) THEN
+            CALL flioputa (il_ncid, "?", "LOGNAME"      , TRIM(c_tmp) )
+         ELSE 
+            WRITE (nout,*) 'Environment variable not found : $LOGNAME'
+         END IF
+         !
+         CALL fliodefv (il_ncid, 'src_grid_dims'      , (/5/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'dst_grid_dims'      , (/6/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'src_grid_center_lat', (/1/)  , v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'src_grid_center_lon', (/1/)  , v_t=flio_r , units = "degrees_east" )
+         CALL fliodefv (il_ncid, 'dst_grid_center_lat', (/2/)  , v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'dst_grid_center_lon', (/2/)  , v_t=flio_r , units = "degrees_east" )
+         CALL fliodefv (il_ncid, 'src_grid_corner_lat', (/3,1/), v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'src_grid_corner_lon', (/3,1/), v_t=flio_r , units = "degrees_east" )
+         CALL fliodefv (il_ncid, 'dst_grid_corner_lat', (/4,2/), v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'dst_grid_corner_lon', (/4,2/), v_t=flio_r , units = "degrees_east" )
+         CALL fliodefv (il_ncid, 'src_grid_imask'     , (/1/)  , v_t=flio_i , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'dst_grid_imask'     , (/2/)  , v_t=flio_i , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'src_grid_area'      , (/1/)  , v_t=flio_r , units = "m^2" )
+         CALL fliodefv (il_ncid, 'dst_grid_area'      , (/2/)  , v_t=flio_r , units = "m^2" )
+         CALL fliodefv (il_ncid, 'src_grid_frac'      , (/1/)  , v_t=flio_r , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'dst_grid_frac'      , (/2/)  , v_t=flio_r , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'dst_address'        , (/7/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'src_address'        , (/7/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'remap_matrix'       , (/8,7/), v_t=flio_r )
+         !   
+         CALL flioputa (il_ncid, 'src_grid_imask', 'land_value', 0)
+         CALL flioputa (il_ncid, 'src_grid_imask', 'sea_value' , 1)
+         CALL flioputa (il_ncid, 'dst_grid_imask', 'land_value', 0)
+         CALL flioputa (il_ncid, 'dst_grid_imask', 'sea_value' , 1)
+         !
+         CALL flioputv (il_ncid, 'src_grid_dims'      , (/ jpoi, jpoj /) ) 
+         CALL flioputv (il_ncid, 'dst_grid_dims'      , (/ jpai, jpaj /) )
+         CALL flioputv (il_ncid, 'src_grid_center_lat',         xolatt )
+         CALL flioputv (il_ncid, 'src_grid_center_lon', lon_180(xolont))
+         CALL flioputv (il_ncid, 'dst_grid_center_lat',         xalatt )
+         CALL flioputv (il_ncid, 'dst_grid_center_lon', lon_180(xalont))
+         
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         yo_ed (:,1)  , start=(/1,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         yo_ed (:,3)  , start=(/2,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         yo_ed (:,5)  , start=(/3,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         yo_ed (:,8)  , start=(/4,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 1)), start=(/1,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 3)), start=(/2,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 5)), start=(/3,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xo_ed (:, 8)), start=(/4,1/), count=(/1,jpon/) )
+         
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         ya_ed (:, 1) , start=(/1,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         ya_ed (:, 3) , start=(/2,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         ya_ed (:, 5) , start=(/3,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         ya_ed (:, 8) , start=(/4,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 1)), start=(/1,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 3)), start=(/2,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 5)), start=(/3,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xa_ed (:, 8)), start=(/4,1/), count=(/1,jpan/) )
+         
+         CALL flioputv (il_ncid, 'src_grid_imask'     , (1-iomskt)*(1-iomskp) )
+         CALL flioputv (il_ncid, 'dst_grid_imask'     , 1-o2amask_i_int*(1-iomskp) )
+         CALL flioputv (il_ncid, 'src_grid_area'      , xosrft )
+         CALL flioputv (il_ncid, 'dst_grid_area'      , xasrft )
+         
+         CALL flioputv (il_ncid, 'dst_grid_frac'      , o2amask )
+         
+         
+         IF (l_src_grid_frac) THEN
+            CALL flioputv (il_ncid, 'src_grid_frac'      , REAL ((1-iomskt)*(1-iomskp),KIND=rl) )
+         ELSE
+            CALL flioputv (il_ncid, 'src_grid_frac'      , REAL (1-0*iomskt,KIND=rl) )
+         ENDIF
+         IF (l_dst_grid_frac) THEN
+            CALL flioputv (il_ncid, 'dst_grid_frac'      , o2amask )
+         ELSE
+            CALL flioputv (il_ncid, 'dst_grid_frac'      , 1.0_rl+0.0_rl*o2amask )
+         END IF
+         
+         CALL flioputv (il_ncid, 'dst_address'        , k_dst (1:num_links) )
+         CALL flioputv (il_ncid, 'src_address'        , k_src (1:num_links) )
+         CALL flioputv (il_ncid, 'remap_matrix '      , w_mct (1:num_wgts,1:num_links) )
+         
+         !!
+         CALL flioclo (il_ncid)
+      END IF
+      
+      RETURN
+      
+   END SUBROUTINE wri_weights_o2a
+   !!
+   SUBROUTINE wri_weights_a2o (cldiag_a2o, clw_a2o, clw_a2o_mct, clnum, l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac, &
+                               co_omsk, co_amsk )
+      !> Write atmosphere -> ocean weights and adresses
+      IMPLICIT NONE
+      !!
+      CHARACTER (len=1), INTENT (in) :: clnum
+      CHARACTER (len=*) :: cldiag_a2o, clw_a2o, clw_a2o_mct
+      LOGICAL, INTENT (in), OPTIONAL :: l_fulldiag, lo_src_grid_frac, lo_dst_grid_frac
+      CHARACTER (len=*), INTENT (in), OPTIONAL :: co_omsk, co_amsk
+      INTEGER (KIND=il) :: nca2o, ierr, num_links, num_wgts 
+      INTEGER (KIND=il) :: il_ncid
+      INTEGER (KIND=il) :: joi, joj, ja, jo, j_link
+      INTEGER (KIND=il) :: jn, jw, j1, j2, i_var, i_stat, isize_max, isize, ideb, ifin
+      LOGICAL :: l_fd, l_src_grid_frac, l_dst_grid_frac
+      CHARACTER (len=20) :: c_omsk, c_amsk
+      CHARACTER (len=180) :: c_date, c_time, c_zone, c_tmp
+      !!
+      REAL    (KIND=rl), DIMENSION (:,:,:), ALLOCATABLE :: w_3d
+      INTEGER (KIND=il), DIMENSION (:,:,:), ALLOCATABLE :: k_3d
+      !!
+      REAL    (kind=rl), DIMENSION (:,:), ALLOCATABLE :: w_mct
+      INTEGER (kind=il), DIMENSION (:)  , ALLOCATABLE :: k_src, k_dst
+      !
+      l_fd = .TRUE.
+      IF (PRESENT (l_fulldiag)) THEN 
+         l_fd = l_fulldiag
+      ELSE
+         !! Estimation de la taille des variables, limitation si > 2GB
+         i_var = jpoi * jpoj * jmo2a
+         IF ( i_var >= 2E9_il ) l_fd = .TRUE.
+      END IF
+
+      IF ( PRESENT (lo_src_grid_frac) ) THEN
+         l_src_grid_frac = lo_src_grid_frac
+      ELSE
+         l_src_grid_frac = .TRUE.
+      END IF
+      WRITE (nout,*) 'wri_wei_a2o : l_src_grid_frac  : ', l_src_grid_frac 
+
+      IF ( PRESENT (lo_dst_grid_frac) ) THEN
+         l_dst_grid_frac = lo_dst_grid_frac
+      ELSE
+         l_dst_grid_frac = .TRUE.
+      END IF
+      WRITE (nout,*) 'wri_wei_a2o : l_dst_grid_frac : ', l_dst_grid_frac
+
+      IF ( PRESENT (co_omsk) ) THEN
+         c_omsk = TRIM(co_omsk)
+      ELSE
+         c_omsk = 'perio'
+      END IF
+      WRITE (nout,*) 'wri_wei_a2o : c_omsk : ', TRIM ( c_omsk)
+
+      IF ( PRESENT (co_amsk) ) THEN
+         c_amsk = TRIM( co_amsk) 
+      ELSE
+         c_amsk = 'int'
+      END IF
+      WRITE (nout,*) 'wri_wei_a2o : c_amsk : ', TRIM(c_amsk)
+
+      !IF ( LEN_TRIM(c_suffix) /= 0) c_suffix = '_' // TRIM(c_suffix)
+      !!      
+      !! Dataset atmosphere --> ocean
+      !!
+      clweight =  "WEIGHTS" // clnum ; cladress = "ADRESSE" // clnum
+      WRITE (UNIT = nout, fmt = *) " atm -> oce ", cladress, " ", clweight, " Number of neighbors : ", jma2o
+      IF (c_oasis == '2.2' ) THEN
+         IF (l_wei_i4 .OR. l_wei_i8) WRITE (unit = nout, fmt = *) 'Ecriture a2o, fichiers binaires IEEE'
+         IF (l_wei_i4) THEN
+            WRITE (UNIT = nwei4a2o) cladress
+            WRITE (UNIT = nwei4a2o) ((INT (ka2o (jn, jo) , KIND=i_4), jn = 1_il, jma2o), jo = 1_il, jpon)
+            WRITE (UNIT = nwei4a2o) clweight
+            WRITE (UNIT = nwei4a2o) ((REAL (wa2o (jn, jo), KIND=rk_out), jn = 1_il, jma2o), jo = 1_il, jpon)
+         END IF
+         IF (l_wei_i8) THEN
+            WRITE (UNIT = nwei8a2o) cladress
+            WRITE (UNIT = nwei8a2o) ((INT  (ka2o (jn, jo), KIND=i_8), jn = 1_il, jma2o), jo = 1_il, jpon)
+            WRITE (UNIT = nwei8a2o) clweight
+            WRITE (UNIT = nwei8a2o) ((REAL (wa2o (jn, jo), KIND=rk_out), jn = 1_il, jma2o), jo = 1_il, jpon)
+         END IF
+      ENDIF
+
+      ! CALL ipsldbg (new_status=.TRUE. )
+      WRITE (unit = nout, fmt = *) 'Ecriture a2o, diagnostiques ', TRIM(cldiag_a2o)
+      CALL fliocrfd (TRIM(cldiag_a2o) // TRIM(c_suffix), (/'x   ', 'y   ', 'n   ', 'edge'/), (/jpoi, jpoj, jma2o, jpoe/), &
+         &nca2o, mode=c_FlioMode)
+      CALL fliopstc (nca2o, & 
+         & x_axis_2d = RESHAPE (xolont, (/jpoi, jpoj/)), &
+         & y_axis_2d = RESHAPE (xolatt, (/jpoi, jpoj/)))
+      CALL flioputa (nca2o, '?', 'Comment', TRIM(c_comment) )
+      CALL fliodefv (nca2o, 'Weights_Max'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm max weights')
+      CALL flioputa (nca2o, 'Weights_Max'//clnum, 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'Neighbors'//clnum  , (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm Neighbors')
+      CALL flioputa (nca2o, 'Neighbors'//clnum, 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'Weights_Sum'//clnum, (/1_il,2_il/), v_t=flio_r4, standard_name='Oce -> Atm sum weights')
+      CALL flioputa (nca2o, 'Weights_Sum'//clnum, 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'Mask', (/1_il,2_il/), v_t=flio_i4, standard_name='Oce -> Atm mask')
+      CALL flioputa (nca2o, 'Mask', 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'AtmMask', (/1_il,2_il/), v_t=flio_r4, standard_name='Oce ->Atm OceMask')
+      CALL flioputa (nca2o, 'AtmMask', 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'LonEdge', (/1_il,2_il,4_il/), v_t=flio_r4)
+      CALL flioputa (nca2o, 'LonEdge', 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'LatEdge', (/1_il,2_il,4_il/), v_t=flio_r4) 
+      CALL flioputa (nca2o, 'LatEdge', 'missing_value', 0.0_rl)
+      IF (l_fd) THEN 
+         CALL fliodefv (nca2o, 'Weights'//clnum, (/1_il,2_il,3_il/), v_t=flio_r4, standard_name='Oce -> Atm Weights')
+         CALL flioputa (nca2o, 'Weights'//clnum, 'missing_value', 0.0_rl)
+         CALL fliodefv (nca2o, 'Adresses'//clnum,(/1_il,2_il,3_il/), v_t=flio_i4, standard_name='Oce -> Atm Adresses')
+         CALL flioputa (nca2o, 'Adresses'//clnum, 'missing_value', 0.0_rl)
+         CALL fliodefv (nca2o, 'Index_I'//clnum, (/1_il,2_il,3_il/), v_t=flio_i4)
+         CALL flioputa (nca2o, 'Index_I'//clnum, 'missing_value', 0.0_rl)
+         CALL fliodefv (nca2o, 'Index_J'//clnum, (/1_il,2_il,3_il/), v_t=flio_i4)
+         CALL flioputa (nca2o, 'Index_J'//clnum, 'missing_value', 0.0_rl)
+      END IF
+      CALL fliodefv (nca2o, 'MaskPer', (/1_il,2_il/), v_t=flio_i4)
+      CALL flioputa (nca2o, 'MaskPer', 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'Surface', (/1_il,2_il/))
+      CALL flioputa (nca2o, 'Surface', 'missing_value', 0.0_rl)
+      CALL fliodefv (nca2o, 'SurfacePol', (/1_il,2_il/))
+      CALL flioputa (nca2o, 'SurfacePol', 'missing_value', 0.0_rl)
+
+      ALLOCATE (w_3d(jpoi, jpoj, 1), STAT=ierr) ; CALL chk_allo (ierr, 'w_3d(jpoi,jpoj,1)')
+      w_3d (1:jpoi , 1:jpoj, 1) = RESHAPE (MAXVAL (wa2o,DIM=1), (/jpoi, jpoj/))
+      CALL flioputv (nca2o, 'Weights_Max'//clnum, w_3d (1:jpoi, 1:jpoj, 1) )
+      !CALL flioputv (nca2o, 'Weights_Max'//clnum, RESHAPE(MAXVAL(wa2o,DIM=1),(/jpoi, jpoj/)) )
+      CALL flioputv (nca2o, 'Neighbors'//clnum,   RESHAPE ( MAX (0_il, nvo) ,(/jpoi, jpoj/)) )
+      CALL flioputv (nca2o, 'Weights_Sum'//clnum, RESHAPE ( SUM (wa2o,DIM=1),(/jpoi, jpoj/)) )
+      CALL flioputv (nca2o, 'Mask',    RESHAPE (1_il-iomskt, (/jpoi, jpoj/)) )
+      CALL flioputv (nca2o, 'AtmMask', RESHAPE (a2omask, (/jpoi, jpoj/)) )
+      CALL flioputv (nca2o, 'LonEdge', RESHAPE (xo_ed, (/jpoi, jpoj, jpoe/)) )
+      CALL flioputv (nca2o, 'LatEdge', RESHAPE (yo_ed, (/jpoi, jpoj, jpoe/)) )
+      CALL flioputv (nca2o, 'Surface', RESHAPE (xosrft, (/jpoi,jpoj/)))
+      CALL flioputv (nca2o, 'SurfacePol', RESHAPE(xosrft_pol, (/jpoi,jpoj/)))
+      DEALLOCATE (w_3d)
+      
+      IF (l_fd) THEN 
+         ALLOCATE (w_3d(jpoi, jpoj, jma2o), STAT=ierr)
+         CALL chk_allo (ierr, 'w_3d(jpoi,jpoj,jma2o)', lreset=.TRUE., crout='wri_wei_a2o')
+         ALLOCATE (k_3d(jpoi, jpoj, jma2o), STAT=ierr)
+         CALL chk_allo (ierr, 'k_3d(jpai,jpaj,jmo2a)')
+         
+         IF (ierr /= 0 ) THEN
+            WRITE(UNIT=nout,fmt=*) 'Erreur allocation k_3d dans wri_wei_a2o : ', ierr
+            STOP
+         END IF
+         DO jn = 1_il, jma2o
+            DO joj = 1_il, jpoj
+               DO joi = 1_il, jpoi
+                  w_3d (joi, joj, jn) = wa2o (jn, m1o(joi, joj))
+                  k_3d (joi, joj, jn) = ka2o (jn, m1o(joi, joj))
+               END DO
+            END DO
+         END DO
+         !!
+         IF (limit_stack) THEN
+            DO jn = 1_il, jma2o
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nca2o, 'Weights'//clnum, w_3d(:,:,jn), start=(/1_il, 1_il, jn/) )
+            ENDDO
+         ELSE
+            CALL flioputv (nca2o, 'Weights'//clnum, w_3d(:,:,:) )
+         ENDIF
+         !!
+         IF (limit_stack) THEN
+            DO jn = 1_il, jma2o
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nca2o, 'Adresses'//clnum, k_3d(:,:,jn), start=(/1_il, 1_il, jn/) )
+            ENDDO
+         ELSE
+            CALL flioputv (nca2o, 'Adresses'//clnum, k_3d(:,:,1:jma2o)) 
+         ENDIF
+         !!
+         CALL flioputv (nca2o, 'MaskPer',  & 
+            RESHAPE( (1_il-iomskt)*(1_il-iomskp), (/jpoi, jpoj/) ) )
+         !!
+         DEALLOCATE (w_3d)
+         !!
+         k_3d = 0_il
+         DO jn = 1_il, jma2o
+            DO joj = 1_il, jpoj
+               DO joi = 1_il, jpoi
+                  k_3d (joi, joj, jn) = m2ai(ka2o(jn, m1o(joi, joj)))
+               END DO
+            END DO
+         END DO
+         IF (limit_stack) THEN
+            DO jn = 1_il, jma2o
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nca2o, 'Index_I'//clnum, k_3d(:,:,jn), start=(/1_il,1_il,jn/) )
+            ENDDO
+         ELSE
+            CALL flioputv (nca2o, 'Index_I'//clnum, k_3d(:,:,1:jma2o)) 
+         ENDIF
+         k_3d = 0_il
+         DO jn = 1_il, jma2o
+            DO joj = 1_il, jpoj
+               DO joi = 1_il, jpoi
+                  k_3d (joi, joj, jn) = m2aj(ka2o (jn, m1o(joi, joj)))
+               END DO
+            END DO
+         END DO
+         IF (limit_stack) THEN
+            DO jn = 1_il, jma2o
+               !WRITE (UNIT=nout,FMT='(1I4)') jn
+               CALL flioputv (nca2o, 'Index_J'//clnum, k_3d(:,:,jn), start=(/1_il,1_il,jn/) )
+            END DO
+         ELSE
+            CALL flioputv (nca2o, 'Index_J'//clnum, k_3d(:,:,1:jma2o))
+         ENDIF
+         !
+         DEALLOCATE (k_3d)
+         !!
+      END IF
+      !!
+      WRITE (unit=nout,fmt=*) 'Fin ecriture diagnostiques a2o '
+      CALL flioclo (nca2o)
+      !!
+      !!
+      !! Ecriture des poids au format NetCDF de OASIS 3
+      IF ( l_wei_oasis_3 ) THEN
+         WRITE (unit=nout,fmt=*) 'Ecriture poids a2o NetCDF, format OASIS 3'
+         CALL fliocrfd (TRIM(clw_a2o) // TRIM(c_suffix) // '.nc', (/'jma2o', 'jpon '/), (/jma2o, jpon/), il_ncid, mode=c_FlioMode)
+         CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) )
+         CALL fliodefv (il_ncid, 'WEIGHTS'//clnum, (/1,2/), v_t=flio_r)
+         CALL fliodefv (il_ncid, 'ADRESSE'//clnum, (/1,2/), v_t=flio_i)
+         ! Write WEIGHTS
+         IF (limit_stack) THEN
+            j1 = 1 ; j2 = MIN (slice_size, jma2o)
+            DO WHILE (j1 < jma2o)
+               WRITE (UNIT=nout,FMT='("Ecriture wa2o, jn : ", 2I6, 5I8)') j1, j2, SIZE (wa2o(j1:j2,:))
+               CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wa2o(j1:j2,:), start=(/j1,1_il/), count=(/j2-j1+1,jpon/) )
+               j1 = j1 + slice_size ; j2 = MIN (j1+slice_size-1, jma2o)
+            END DO
+         ELSE
+            WRITE (UNIT=nout,FMT='(5I10)') SIZE (wa2o(1:jma2o,:)), SIZE(wa2o(1:jma2o,:),DIM=1), SIZE(wa2o(1:jma2o,:),DIM=2) 
+            CALL flioputv (il_ncid, 'WEIGHTS'//clnum, wa2o(1:jma2o,:) )
+         ENDIF
+         ! Write ADRESSE
+         IF (limit_stack) THEN
+            j1 = 1 ; j2 = MIN (slice_size, jma2o)
+            DO WHILE ( j1 < jma2o)
+               WRITE (UNIT=nout,FMT='("Ecriture ka2o, jn : ", 2I6, 5I8)') j1, j2, SIZE (ka2o(j1:j2,:))
+               CALL flioputv (il_ncid, 'ADRESSE'//clnum, ka2o(j1:j2,:), start=(/j1,1_il/), count=(/j2-j1+1,jpon/) )
+               j1 = j1 + slice_size ; j2 = MIN (j1+slice_size-1, jma2o)
+            END DO
+         ELSE
+            WRITE (UNIT=nout,FMT='(5I10)') SIZE (ka2o(1:jma2o,:)), SIZE (ka2o(1:jma2o,:),DIM=1), SIZE (ka2o(1:jma2o,:),DIM=2) 
+            CALL flioputv (il_ncid, 'ADRESSE'//clnum, ka2o(1:jma2o,:) ) 
+         ENDIF
+         !!
+         WRITE (unit=nout, fmt=*) 'Fin ecriture adresses a2o NetCDF, format OASIS 3'
+         CALL flioclo (il_ncid)
+         !!
+         WRITE (unit=nout,fmt=*) 'Ecriture poids a2o NetCDF, format OASIS MCT'
+         num_links = jpon * jma2o
+         num_wgts  = 1
+         ALLOCATE (w_mct(num_wgts,num_links), STAT=ierr) 
+         CALL chk_allo (ierr, 'w_mct(num_wgts,num_links)', lreset=.TRUE., crout='wri_wei_a2o')
+         ALLOCATE (k_src(num_links), STAT=ierr) 
+         CALL chk_allo (ierr, 'k_src(num_links)', lreset=.TRUE., crout='wri_wei_a2o')
+         ALLOCATE (k_dst(num_links), STAT=ierr) 
+         CALL chk_allo (ierr, 'k_dst(num_links)', lreset=.TRUE., crout='wri_wei_a2o')
+         !
+         j_link = 0
+         DO jo = 1, jpon
+            DO jn = 1, jma2o
+               IF ( ka2o (jn, jo) /= 0 ) THEN 
+                  j_link = j_link + 1
+                  k_dst (j_link)   = jo
+                  k_src (j_link)   = ka2o (jn, jo)
+                  w_mct (1,j_link) = wa2o (jn, jo) 
+               END IF
+            END DO
+         END DO
+         num_links = j_link
+         !
+      END IF
+      !
+         !! Ecriture des poids au format NetCDF de OASIS MCT
+      IF ( l_wei_oasis_mct ) THEN
+         CALL fliocrfd (TRIM(clw_a2o_mct) // TRIM(c_suffix), &
+            & (/'src_grid_size   ', 'dst_grid_size   ', 'src_grid_corners', 'dst_grid_corners',   &
+            &   'src_grid_rank   ', 'dst_grid_rank   ', 'num_links       ', 'num_wgts        '/), &
+            & (/ jpan             ,  jpon             ,  4                ,  4                ,   &
+            &    2                ,  2                ,  num_links        ,  num_wgts         /), &
+            & il_ncid, mode=c_FlioMode) 
+         CALL flioputa (il_ncid, "?", "title"         , TRIM(clw_a2o_mct) )
+         CALL flioputa (il_ncid, '?', 'Comment', TRIM(c_comment) )
+         CALL flioputa (il_ncid, "?", "normalization" , "none" )
+         CALL flioputa (il_ncid, "?", "map_method"    , "Conservative Remapping" )
+         CALL DATE_AND_TIME (c_date, c_time, c_zone )
+         CALL flioputa (il_ncid, "?", "history"       , "Created: "//c_date(1:4)//"-"//c_date(5:6)//"-"// &
+            & c_date(7:8)//" "//c_time(1:2)//"h"//c_time(3:4)//" GMT"//TRIM(c_zone) )
+         CALL flioputa (il_ncid, "?", "conventions"   , "SCRIP" )
+         CALL flioputa (il_ncid, "?", "method"        , "MOSAIC" )
+         CALL flioputa (il_ncid, "?", "source_grid"   , "curvilinear" )
+         CALL flioputa (il_ncid, "?", "dest_grid"     , "curvilinear" )
+         CALL flioputa (il_ncid, "?", "Institution"   , "IPSL" )
+         CALL flioputa (il_ncid, "?", "Model"         , "IPSL CM6" )
+         CALL flioputa (il_ncid, "?", "Max_nei_num"   , jma2o )
+         CALL flioputa (il_ncid, "?", "c_amsk"        , TRIM(c_amsk))
+         CALL flioputa (il_ncid, "?", "c_omsk"        , TRIM(c_omsk))
+         CALL GET_ENVIRONMENT_VARIABLE ( NAME="HOSTNAME", VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat)
+         IF ( i_stat == 0 ) THEN
+            CALL flioputa (il_ncid, "?", "HOSTNAME"     , TRIM(c_tmp) )
+         ELSE 
+            WRITE (nout,*) 'Environment variable not found : $HOSTNAME'
+         END IF
+         CALL GET_ENVIRONMENT_VARIABLE ( NAME="LOGNAME" , VALUE=c_tmp, TRIM_NAME=.TRUE., STATUS=i_stat)
+         IF ( i_stat == 0 ) THEN
+            CALL flioputa (il_ncid, "?", "LOGNAME"      , TRIM(c_tmp) )
+         ELSE 
+            WRITE (nout,*) 'Environment variable not found : $LOGNAME'
+         END IF
+         !
+         CALL fliodefv (il_ncid, 'src_grid_dims'      , (/5/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'dst_grid_dims'      , (/6/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'src_grid_center_lat', (/1/)  , v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'src_grid_center_lon', (/1/)  , v_t=flio_r , units = "degrees_east"  )
+         CALL fliodefv (il_ncid, 'dst_grid_center_lat', (/2/)  , v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'dst_grid_center_lon', (/2/)  , v_t=flio_r , units = "degrees_east"  )
+         CALL fliodefv (il_ncid, 'src_grid_corner_lat', (/3,1/), v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'src_grid_corner_lon', (/3,1/), v_t=flio_r , units = "degrees_east"  )
+         CALL fliodefv (il_ncid, 'dst_grid_corner_lat', (/4,2/), v_t=flio_r , units = "degrees_north" )
+         CALL fliodefv (il_ncid, 'dst_grid_corner_lon', (/4,2/), v_t=flio_r , units = "degrees_east"  )
+         CALL fliodefv (il_ncid, 'src_grid_imask'     , (/1/)  , v_t=flio_i , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'dst_grid_imask'     , (/2/)  , v_t=flio_i , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'src_grid_area'      , (/1/)  , v_t=flio_r , units = "m^2" )
+         CALL fliodefv (il_ncid, 'dst_grid_area'      , (/2/)  , v_t=flio_r , units = "m^2" )
+         CALL fliodefv (il_ncid, 'src_grid_frac'      , (/1/)  , v_t=flio_r , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'dst_grid_frac'      , (/2/)  , v_t=flio_r , units = "unitless"      )
+         CALL fliodefv (il_ncid, 'dst_address'        , (/7/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'src_address'        , (/7/)  , v_t=flio_i )
+         CALL fliodefv (il_ncid, 'remap_matrix'       , (/8,7/), v_t=flio_r )
+         !
+         CALL flioputa (il_ncid, 'src_grid_imask', 'land_value', 0)
+         CALL flioputa (il_ncid, 'src_grid_imask', 'sea_value' , 1)
+         CALL flioputa (il_ncid, 'dst_grid_imask', 'land_value', 0)
+         CALL flioputa (il_ncid, 'dst_grid_imask', 'sea_value' , 1)
+         !
+         CALL flioputv (il_ncid, 'src_grid_dims'      , (/ jpai, jpaj /) ) 
+         CALL flioputv (il_ncid, 'dst_grid_dims'      , (/ jpoi, jpoj /) )
+         CALL flioputv (il_ncid, 'src_grid_center_lat',         xalatt )
+         CALL flioputv (il_ncid, 'src_grid_center_lon', lon_180(xalont))
+         CALL flioputv (il_ncid, 'dst_grid_center_lat',         xolatt )
+         CALL flioputv (il_ncid, 'dst_grid_center_lon', lon_180(xolont))
+         
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         ya_ed (:,1) , start=(/1,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         ya_ed (:,3) , start=(/2,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         ya_ed (:,5) , start=(/3,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lat',         ya_ed (:,8) , start=(/4,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,1)), start=(/1,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,3)), start=(/2,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,5)), start=(/3,1/), count=(/1,jpan/) )
+         CALL flioputv (il_ncid, 'src_grid_corner_lon', lon_180(xa_ed (:,8)), start=(/4,1/), count=(/1,jpan/) )
+         
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         yo_ed (:,1) , start=(/1,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         yo_ed (:,3) , start=(/2,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         yo_ed (:,5) , start=(/3,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lat',         yo_ed (:,8) , start=(/4,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,1)), start=(/1,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,3)), start=(/2,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,5)), start=(/3,1/), count=(/1,jpon/) )
+         CALL flioputv (il_ncid, 'dst_grid_corner_lon', lon_180(xo_ed (:,8)), start=(/4,1/), count=(/1,jpon/) )
+
+         SELECT CASE ( TRIM(c_amsk) )
+         CASE ( 'ext' )
+            CALL flioputv (il_ncid, 'src_grid_imask'        , 1-o2amask_i_ext     )
+         CASE ( 'int' )
+            CALL flioputv (il_ncid, 'src_grid_imask'        , 1-o2amask_i_int     )
+         CASE ( 'full')
+            CALL flioputv (il_ncid, 'src_grid_imask'        , 0*(1-o2amask_i_int) )
+         END SELECT
+         
+         SELECT CASE ( TRIM (c_omsk) )
+         CASE ( 'noperio' )
+            CALL flioputv (il_ncid, 'dst_grid_imask'     , (1-iomskt)*(1-iomskp) )
+         CASE ( 'perio' )
+            CALL flioputv (il_ncid, 'dst_grid_imask'     , (1-iomskt)            )
+         END SELECT
+         
+         CALL flioputv (il_ncid, 'src_grid_area'      , xasrft )
+         CALL flioputv (il_ncid, 'dst_grid_area'      , xosrft )
+         IF (l_src_grid_frac) THEN
+            CALL flioputv (il_ncid, 'src_grid_frac'      , o2amask )
+         ELSE
+            CALL flioputv (il_ncid, 'src_grid_frac'      , o2amask*0.0_rl+1.0_rl )
+         ENDIF
+         IF (l_dst_grid_frac) THEN
+            SELECT CASE ( TRIM(c_omsk))
+            CASE ('noperio' )
+               CALL flioputv (il_ncid, 'dst_grid_frac'      , REAL ((1-iomskt)*(1-iomskp),KIND=rl) )
+            CASE ( 'perio' )
+               CALL flioputv (il_ncid, 'dst_grid_frac'      , REAL ((1-iomskt)           ,KIND=rl) )
+            END SELECT
+         ELSE
+            SELECT CASE ( TRIM(c_omsk))
+            CASE ('noperio' )
+               CALL flioputv (il_ncid, 'dst_grid_frac'      , REAL ( (1-0*iomskt)*(1-0*iomskp) ,KIND=rl) )
+            CASE ( 'perio' )
+               CALL flioputv (il_ncid, 'dst_grid_frac'      , REAL ( (1-0*iomskt)              ,KIND=rl) )
+            END SELECT
+         END IF
+         
+         CALL flioputv (il_ncid, 'dst_address'        , k_dst (1:num_links) )
+         CALL flioputv (il_ncid, 'src_address'        , k_src (1:num_links) )
+         CALL flioputv (il_ncid, 'remap_matrix '      , w_mct (1:num_wgts,1:num_links) )
+         
+         !!
+         CALL flioclo (il_ncid)
+      END IF
+      !!
+      !!
+      RETURN
+   END SUBROUTINE wri_weights_a2o
+END MODULE mod_wri_wei
Index: /TOOLS/MOZAIC/src/MOZAIC/wripoly.f90
===================================================================
--- /TOOLS/MOZAIC/src/MOZAIC/wripoly.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/MOZAIC/wripoly.f90	(revision 3326)
@@ -0,0 +1,64 @@
+! -*- Mode: f90 -*-
+MODULE mod_wripoly
+CONTAINS
+  SUBROUTINE wripoly 
+    !>
+    !! Write polygones of ocean and atmosphere on a restricted area in two files, 
+    !! for a later use for test of the method to find common surfaces between two polygones.
+    !! 
+    USE declare
+    USE modeles
+    USE mod_proj
+    IMPLICIT NONE
+    !!
+    INTEGER (kind=il) :: jo, ja, jn, nn, kp, kerr(9)
+    REAL (kind=rd) :: xl, xu, yl, yu, plon0, plat0
+    REAL (kind=rd), DIMENSION (9) :: px, py
+    !!
+    !! bounds of area
+    xl = 0.0_rl ; xu = 20.0_rl ; yl = 60.0_rl ; yu = 80.0_rl
+    !! Pole of projection
+    plon0 = 0.5 * ( xl + xu ) ; plat0 = 0.5 * ( yl + yu)
+    !! Type of projection
+    kp = 2
+    !!
+    !! Atmosphere
+    OPEN ( unit = 36, file = 'poly.atm', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' )
+    !
+    nn = 0
+    DO ja = 1, jpan
+      IF (       MINVAL ( xa_ed (ja,:)) .LE. xu .AND. MAXVAL ( xa_ed(ja,:)) .GE. xl &
+         & .AND. MINVAL ( ya_ed (ja,:)) .LE. yu .AND. MAXVAL ( ya_ed(ja,:)) .GE. yl ) THEN
+          DO jn = 1, jpae
+            CALL proj ( xa_ed(ja,jn), ya_ed(ja,jn), plon0, plat0, px(jn), py(jn), kp, kerr(jn) )
+          END DO
+          IF ( SUM(kerr) == 0 ) THEN 
+              WRITE ( unit = 36, fmt = '(16F9.4)' )  ( (/ px(jn), py(jn) /), jn = 1, jpae-1 ) 
+              nn = nn + 1
+          END IF
+      END IF
+    END DO
+    CLOSE ( unit = 36)
+    !!
+    !! Ocean
+    OPEN ( unit = 36, file = 'poly.oce', form = 'formatted', status ='unknown', action = 'write', position = 'rewind' )
+    !
+    nn = 0
+    DO jo = 1, jpon
+      IF (       MINVAL ( xo_ed (jo,:)) .LE. xu .AND. MAXVAL ( xo_ed(jo,:)) .GE. xl &
+         & .AND. MINVAL ( yo_ed (jo,:)) .LE. yu .AND. MAXVAL ( yo_ed(jo,:)) .GE. yl ) THEN
+          DO jn = 1, jpoe
+            CALL proj ( xo_ed(jo,jn), yo_ed(jo,jn), plon0, plat0, px(jn), py(jn), kp, kerr(jn) )
+          END DO
+          IF ( SUM(kerr) == 0 ) THEN 
+              WRITE ( unit = 36, fmt = '(16F9.4)' )  ( (/ px(jn), py(jn) /), jn = 1, jpae-1 ) 
+              nn = nn + 1
+          END IF
+      END IF
+    END DO
+    CLOSE ( unit = 36)
+    !!
+    RETURN
+    !!
+  END SUBROUTINE wripoly
+END MODULE mod_wripoly
Index: /TOOLS/MOZAIC/src/POLY/m_g2d.f90
===================================================================
--- /TOOLS/MOZAIC/src/POLY/m_g2d.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/POLY/m_g2d.f90	(revision 3326)
@@ -0,0 +1,153 @@
+MODULE m_g2d
+   !>---------------------------------------------------------------------
+   !!- elements algebriques 2d
+   !!---------------------------------------------------------------------
+   !!- type :    c2d : couple de composantes (x,y)
+   !!-
+   !!- operations :
+   !!-   v    = r         v = (r,r)
+   !!-   v    = r(1:2)    v = (r(1),r(2))
+   !!-   r(1:2) = v       r(1:2) = (/v%x,v%y/)
+   !!-   v1+v2            addition
+   !!-   v1-v2            soustraction
+   !!-   -v               changement de signe
+   !!-   v*r, r*v         reel*vecteur
+   !!-   v1.s.v2          produit scalaire
+   !!-   v1.v.v2          produit vectoriel
+   !!-   v1.a.v2          angle (en radians) entre v1 et v2
+   !!-
+   !!- fonctions : 
+   !!-   v2 = vn_2d(v1)   v2 est v1 normalise a 1.
+   !!---------------------------------------------------------------------
+   USE poly_types
+   USE mt_c2d
+   IMPLICIT NONE
+   !-
+   !> Affection
+   INTERFACE ASSIGNMENT(=)
+      MODULE PROCEDURE c2d_equ_c2d, c2d_equ_r, c2d_equ_v2, v2_equ_c2d
+   END INTERFACE
+   !> Add 
+   INTERFACE OPERATOR(+)
+      MODULE PROCEDURE add_c2d
+   END INTERFACE
+   !> Substract
+   INTERFACE OPERATOR(-)
+      MODULE PROCEDURE sub_c2d,inv_c2d
+   END INTERFACE
+   !> Multiply
+   INTERFACE OPERATOR(*)
+      MODULE PROCEDURE mul_c2d_r,mul_r_c2d
+   END INTERFACE
+   !> Scalar product
+   INTERFACE OPERATOR(.s.)
+      MODULE PROCEDURE ps_c2d
+   END INTERFACE
+   !> Vector product
+   INTERFACE OPERATOR(.v.)
+      MODULE PROCEDURE pv_c2d
+   END INTERFACE
+   !> Normalize
+   INTERFACE OPERATOR(.a.)
+      MODULE PROCEDURE av_c2d
+   END INTERFACE
+   !-
+CONTAINS
+   !> affectation
+   SUBROUTINE c2d_equ_c2d (vs,ve) !> affectation
+      !> affectation
+      !
+      !> Output vector (left hand)
+      TYPE(c2d),INTENT(out) :: vs
+      !> Output vector (right hand)
+      TYPE(c2d),INTENT(in)  :: ve
+      vs%x = ve%x; vs%y = ve%y;
+   END SUBROUTINE c2d_equ_c2d
+   !
+   SUBROUTINE c2d_equ_r (vs,re)
+      !> affectation
+      !> Output vector (left hand)
+      TYPE(c2d),INTENT(out) :: vs 
+      !> Input real (right hand)
+      REAL (kind=rp),INTENT(in) :: re
+      vs%x = re; vs%y = re;
+   END SUBROUTINE c2d_equ_r
+   SUBROUTINE c2d_equ_v2 (vs,te)
+      !> affectation
+      !> Output vector (left hand)
+      TYPE(c2d),INTENT(out)        :: vs
+      !> Input real array (2 reals), (right hand)
+      REAL (kind=rp),DIMENSION(2),INTENT(in) :: te
+      vs%x  = te(1); vs%y = te(2);
+   END SUBROUTINE c2d_equ_v2
+   SUBROUTINE v2_equ_c2d (ts,ve)
+      !> affectation
+      !
+      !> Input vector (right hand)
+      TYPE(c2d),INTENT(in)          :: ve
+      !> Output real array (2 reals), (left hand)
+      REAL (kind=rp),DIMENSION(2),INTENT(out) :: ts 
+      ts(1) = ve%x; ts(2) = ve%y;
+   END SUBROUTINE v2_equ_c2d
+   !> addition
+   TYPE(c2d) FUNCTION add_c2d (v1,v2)
+      TYPE(c2d),INTENT(in):: v1,v2
+      add_c2d%x = v1%x+v2%x; add_c2d%y = v1%y+v2%y;
+   END FUNCTION add_c2d
+   !> soustraction
+   TYPE(c2d) FUNCTION sub_c2d (v1,v2)
+      TYPE(c2d),INTENT(in):: v1,v2
+      sub_c2d%x = v1%x-v2%x; sub_c2d%y = v1%y-v2%y;
+   END FUNCTION sub_c2d
+   !> changement de signe
+   TYPE(c2d) FUNCTION inv_c2d (v1)
+      TYPE(c2d),INTENT(in):: v1
+      inv_c2d%x = -v1%x; inv_c2d%y = -v1%y;
+   END FUNCTION inv_c2d
+   !> multiplication
+   TYPE(c2d) FUNCTION mul_c2d_r (v1,r2)
+      TYPE(c2d),INTENT(in) :: v1
+      REAL (kind=rp) ,INTENT(in)      :: r2
+      mul_c2d_r%x = v1%x*r2; mul_c2d_r%y = v1%y*r2;
+   END FUNCTION mul_c2d_r
+   TYPE(c2d) FUNCTION mul_r_c2d (r1,v2)
+      TYPE(c2d),INTENT(in) :: v2
+      REAL (kind=rp),INTENT(in)      :: r1
+      mul_r_c2d%x = v2%x*r1; mul_r_c2d%y = v2%y*r1;
+   END FUNCTION mul_r_c2d
+   !> produit scalaire
+   FUNCTION ps_c2d (v1,v2)
+      REAL (kind=rp) :: ps_c2d
+      TYPE(c2d),INTENT(in) :: v1,v2
+      ps_c2d = v1%x*v2%x+v1%y*v2%y
+   END FUNCTION ps_c2d
+   !> produit vectoriel
+   FUNCTION pv_c2d (v1,v2)
+      real (kind=rp) :: pv_c2d
+      TYPE(c2d),INTENT(in) :: v1,v2
+      pv_c2d = v1%x*v2%y-v1%y*v2%x
+   END FUNCTION pv_c2d
+   !> angle
+   FUNCTION av_c2d (v1,v2)
+      REAL (kind=rp) :: av_c2d
+      TYPE(c2d),INTENT(in) :: v1,v2
+      REAL (kind=rp) :: ps,pv
+      ps = v1.s.v2; pv = v1.v.v2
+      IF ( (ps == 0.).AND.(pv == 0.) ) THEN
+         av_c2d = 0.
+      ELSE
+         av_c2d = ATAN2(pv,ps)
+      END IF
+   END FUNCTION av_c2d
+   !> vecteur normalise
+   TYPE(c2d) FUNCTION vn_2d (v)
+      TYPE(c2d),INTENT(in) ::v
+      REAL (kind=rp) :: n
+      n = SQRT(v.s.v)
+      IF (n>0) THEN
+         vn_2d%x = v%x/n
+         vn_2d%y = v%y/n
+      END IF
+   END  FUNCTION vn_2d
+   !------------------
+END MODULE m_g2d
Index: /TOOLS/MOZAIC/src/POLY/mt_c2d.f90
===================================================================
--- /TOOLS/MOZAIC/src/POLY/mt_c2d.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/POLY/mt_c2d.f90	(revision 3326)
@@ -0,0 +1,11 @@
+! -*- MODE: F90 -*-
+MODULE mt_c2d
+   !> defines the point type
+   USE poly_types
+   !> Polygon type
+   TYPE c2d
+      REAL (kind=rp) :: x !< x-coordinate
+      REAL (kind=rp) :: y !< y-coordinate
+   END TYPE c2d
+END MODULE mt_c2d
+
Index: /TOOLS/MOZAIC/src/POLY/mt_polyg.F90
===================================================================
--- /TOOLS/MOZAIC/src/POLY/mt_polyg.F90	(revision 3326)
+++ /TOOLS/MOZAIC/src/POLY/mt_polyg.F90	(revision 3326)
@@ -0,0 +1,16 @@
+! -*- Mode: f90 -*-
+MODULE mt_polyg
+   !> Defines the polygone type
+   USE poly_types
+   USE mt_c2d
+   !> JPOL is defined by the CPP phase (must be kept uppercase)
+   INTEGER,PARAMETER :: maxpt = JPOL
+
+   !> Polygone type
+   TYPE :: polyg
+      !> Number of polygon summits
+      INTEGER :: n 
+      !> Polygon summits
+      TYPE (c2d), DIMENSION (maxpt) :: pt
+   END TYPE polyg
+END MODULE mt_polyg
Index: /TOOLS/MOZAIC/src/POLY/poly_types.f90
===================================================================
--- /TOOLS/MOZAIC/src/POLY/poly_types.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/POLY/poly_types.f90	(revision 3326)
@@ -0,0 +1,10 @@
+! -*- Mode: f90 -*-
+MODULE poly_types
+   USE defprec
+   USE data_types
+   !!
+   !! Data types
+   INTEGER, PARAMETER :: rp = rl
+   !!
+END MODULE poly_types
+!!
Index: /TOOLS/MOZAIC/src/POLY/u_graph.f90
===================================================================
--- /TOOLS/MOZAIC/src/POLY/u_graph.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/POLY/u_graph.f90	(revision 3326)
@@ -0,0 +1,132 @@
+MODULE u_graph
+   !---------------------------------------------------------------------
+   !- module d'interface graphique
+   !---------------------------------------------------------------------
+   USE poly_types
+   IMPLICIT NONE
+   !-
+   INTEGER,SAVE :: wkid1 = 1,wkcx1 = 70,wktp1 = 1110,wkca1
+   INTEGER,SAVE :: ulerr = 70
+   !---------------------------------------------------------------------
+CONTAINS
+   !-
+   SUBROUTINE g_deb   (vxmin,vxmax,vymin,vymax)
+      !---------------------------------------------------------------------
+      !- debut de graphique
+      !---------------------------------------------------------------------
+      REAL (kind=rp) :: vxmin,vxmax,vymin,vymax
+      !-
+      INTEGER :: pgnt,dcunit,dcdxp,dcdyp,ierr
+      INTEGER,DIMENSION(13) :: iasf = (/ 1,1,1,1,1,1,1,1,1,1,1,1,1 /)
+      REAL (kind=rp),DIMENSION(4) :: wkvp,sndc
+      REAL (kind=rp) :: ddd,dcdxm,dcdym
+      REAL (kind=rp) :: dcdx,dcdy,gx,gy
+      REAL (kind=rp) :: xmi,xms,ymi,yms
+      !---------------------------------------------------------------------
+      !- extrema
+      ddd = vxmax-vxmin; xmi = vxmin-0.1_rp*ddd; xms = vxmax+0.1_rp*ddd;
+      ddd = vymax-vymin; ymi = vymin-0.1_rp*ddd; yms = vymax+0.1_rp*ddd;
+      !- ouverture du fichier des messages d'erreur
+      OPEN    (unit=ulerr,file='dphierr', &
+         status='unknown',form='formatted')
+      !- ouverture de gks
+      CALL gopks   (ulerr,-1)
+      !- obtention de la categorie du poste de travail
+      CALL gqwkca  (wktp1,ierr,wkca1)
+      !- ouverture du poste de travail
+      CALL gopwk   (wkid1,wkcx1,wktp1)
+      !- obtention de la surface maximale d'affichage
+      CALL gqdsp   (wktp1,ierr,dcunit,dcdxm,dcdym,dcdxp,dcdyp)
+      IF (dcunit == 1) THEN
+         dcdxm = dcdxp; dcdym = dcdyp;
+      END IF
+      !- activation du poste de travail
+      CALL gacwk   (wkid1)
+      !- definition des fenetres et clotures
+      pgnt = 1
+      gx   = xms-xmi; gy   = yms-ymi;
+      CALL gswn    (pgnt,xmi,xms,ymi,yms)
+      sndc(1:4) = (/ 0._rp, MIN(1.,gx/gy), 0._rp, MIN(1.,gy/gx) /)
+      CALL gsvp    (pgnt,sndc(1),sndc(2),sndc(3),sndc(4))
+      dcdx = dcdxm*(1._rp-MIN(1._rp,(dcdym*gx)/(dcdxm*gy)))/2._rp
+      dcdy = dcdym*(1._rp-MIN(1._rp,(dcdxm*gy)/(dcdym*gx)))/2._rp
+      wkvp(1:4) = (/ dcdx, (dcdxm-dcdx), dcdy, (dcdym-dcdy) /)
+      CALL gswkwn  (wkid1,sndc(1),sndc(2),sndc(3),sndc(4))
+      CALL gswkvp  (wkid1,wkvp(1),wkvp(2),wkvp(3),wkvp(4))
+      !- activation de la transformation de normalisation
+      CALL gselnt  (pgnt)
+      CALL gsvpip  (0,pgnt,1)
+      CALL gsds    (wkid1,0,1)
+      !- definition du type des attributs
+      CALL gsasf   (iasf)
+      !----------------------
+   END SUBROUTINE g_deb
+   !-
+   SUBROUTINE g_fin
+      !---------------------------------------------------------------------
+      !- fin de graphique
+      !---------------------------------------------------------------------
+      !- desactivation et fermeture du poste de travail
+      CALL gdawk   (wkid1)
+      CALL gclwk   (wkid1)
+      !- fermeture de gks
+      CALL gclks
+      !- fermeture du fichier des messages d'erreur
+      CLOSE  (unit=ulerr)
+      !----------------------
+   END SUBROUTINE g_fin
+   !-
+   SUBROUTINE g_fix
+      !---------------------------------------------------------------------
+      !- fixation du graphique
+      !---------------------------------------------------------------------
+      INTEGER :: istat,ichnb
+      REAL (kind=rp)   :: pxi,pyi
+      !---------------------------------------------------------------------
+      IF (wkca1.EQ.2) THEN
+         CALL grqlc   (wkid1,1,istat,ichnb,pxi,pyi)
+      END IF
+      !----------------------
+   END SUBROUTINE g_fix
+   !-
+   SUBROUTINE g_pln   (np,px,py,il,ic)
+      !---------------------------------------------------------------------
+      !- affichage de polyligne
+      !---------------------------------------------------------------------
+      INTEGER :: np,il,ic
+      REAL (kind=rp), DIMENSION(*) :: px,py
+      !---------------------------------------------------------------------
+      CALL gsln    (il)
+      CALL gsplci  (ic)
+      CALL gpl     (np,px,py)
+      !----------------------
+   END SUBROUTINE g_pln
+   !-
+   SUBROUTINE g_pmk   (np,px,py,ip,ic)
+      !---------------------------------------------------------------------
+      !- affichage de polymarque
+      !---------------------------------------------------------------------
+      INTEGER :: np,ip,ic
+      REAL (kind=rp), DIMENSION(*) :: px,py
+      !---------------------------------------------------------------------
+      !* call gsmksc  (1.)
+      CALL gsmk    (ip)
+      CALL gspmci  (ic)
+      CALL gpm     (np,px,py)
+      !----------------------
+   END SUBROUTINE g_pmk
+   !-
+   SUBROUTINE g_pol   (nv,vx,vy,is,ic)
+      !---------------------------------------------------------------------
+      !- affichage de polygone
+      !---------------------------------------------------------------------
+      INTEGER :: nv,is,ic
+      REAL (kind=rp), DIMENSION(*) :: vx,vy
+      !---------------------------------------------------------------------
+      CALL gsfais  (is)
+      CALL gsfaci  (ic)
+      CALL gfa     (nv,vx,vy)
+      !----------------------
+   END SUBROUTINE g_pol
+   !--------------------
+END MODULE u_graph
Index: /TOOLS/MOZAIC/src/POLY/u_polyg.f90
===================================================================
--- /TOOLS/MOZAIC/src/POLY/u_polyg.f90	(revision 3326)
+++ /TOOLS/MOZAIC/src/POLY/u_polyg.f90	(revision 3326)
@@ -0,0 +1,592 @@
+MODULE u_polyg
+   !---------------------------------------------------------------------
+   !- utilitaires relatifs aux polygones
+   !---------------------------------------------------------------------
+   USE poly_types
+   USE m_g2d
+   USE mt_polyg
+   !-
+   IMPLICIT NONE
+   !-
+   !$ real,parameter :: v_eps = 1.e-4
+   REAL (kind=rp) :: v_eps = 100.0_rp *EPSILON(v_eps)
+   !---------------------------------------------------------------------
+CONTAINS
+   !=
+   SUBROUTINE p_dec   (pol,npd,pd)
+      !---------------------------------------------------------------------
+      !- decomposition d'un polygone quelconque en elements convexes
+      !---------------------------------------------------------------------
+      TYPE(polyg) :: pol
+      INTEGER :: npd
+      TYPE(polyg),DIMENSION(:) :: pd
+      !-
+      TYPE(polyg) :: pv
+      INTEGER :: nppol
+      INTEGER,DIMENSION(pol%n) :: kpt
+      INTEGER,DIMENSION(pol%n) :: tabpt
+      REAL (kind=rp), DIMENSION(pol%n)    :: tabcr
+      !- elements relatifs aux croisements
+      TYPE :: croisement
+         REAL (kind=rp)   :: c1,c2
+         INTEGER :: k1,k2,kp
+      END TYPE croisement
+      INTEGER :: nvcr
+      TYPE(croisement),DIMENSION(3*pol%n) :: tvcr
+      !- elements relatifs aux segments
+      TYPE :: segment
+         INTEGER :: ideb,ifin
+      END TYPE segment
+      INTEGER :: nsgm
+      TYPE(segment),DIMENSION(7*pol%n) :: tsgm
+      !-
+      INTEGER :: npt
+      TYPE(c2d),DIMENSION(5*pol%n) :: tpt
+      !-
+      INTEGER :: n1,n2,n3,ii,ki,kp
+      INTEGER :: ipd,ipc,ib,npw
+      REAL (kind=rp) :: c1,c2,cb,alfa
+      TYPE(c2d) :: d1,d2,ptn
+      INTRINSIC huge
+      !---------------------------------------------------------------------
+      npd = 0; pv = pol;
+      !- reduction du polygone ---------------------------------------------
+      CALL p_red   (pv)
+      !- obtention des elements constitutifs du polygone -------------------
+      nppol = 0; npt = 0;
+      IF (pv%n > 2) THEN
+         DO n1=1,pv%n
+            nppol = nppol+1; ptn = pv%pt(n1);
+            CALL p_apt   (ptn,npt,tpt,kp)
+            kpt(nppol) = kp;
+         ENDDO
+      ENDIF
+      !- recherche des croisements -----------------------------------------
+      nvcr = 0;
+      DO n1=1,nppol-2
+         d1 = tpt(kpt(n1+1))-tpt(kpt(n1));
+         DO n2=n1+2,nppol+MIN(n1-2,0)
+            d2 = tpt(kpt(MOD(n2,nppol)+1))-tpt(kpt(n2));
+            CALL p_i2d (tpt(kpt(n1)),d1,tpt(kpt(n2)),d2,c1,c2,ii)
+            IF (ii > 0) THEN
+               IF (     (     (c1 >  v_eps).AND.(c1 < (1.-v_eps))    &
+                  .AND.(c2 > -v_eps).AND.(c2 < (1.+v_eps)) )  &
+                  .OR.(     (c1 > -v_eps).AND.(c1 < (1.+v_eps))    &
+                  .AND.(c2 >  v_eps).AND.(c2 < (1.-v_eps)) )  ) THEN
+                  nvcr = nvcr+1;
+                  ptn = tpt(kpt(n2))+c2*d2
+                  CALL p_apt   (ptn,npt,tpt,kp)
+                  tvcr(nvcr) = croisement(c1,c2,n1,n2,kp)
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+      !- creation des segments avec inclusion des croisements --------------
+      nsgm = 0;
+      DO n1=1,nppol
+         !--- creation des points
+         ki = 1; tabcr(ki) = 0.; tabpt(ki) = kpt(n1);
+         DO n2=1,nvcr
+            IF      (n1 == tvcr(n2)%k1) THEN
+               ki = ki+1; tabcr(ki) = tvcr(n2)%c1; tabpt(ki) = tvcr(n2)%kp;
+            ELSE IF (n1 == tvcr(n2)%k2) THEN
+               ki = ki+1; tabcr(ki) = tvcr(n2)%c2; tabpt(ki) = tvcr(n2)%kp;
+            ENDIF
+         ENDDO
+         ki = ki+1; tabcr(ki) = 1.; tabpt(ki) = kpt(MOD(n1,nppol)+1);
+         !--- ordonnancement des points
+         DO n3=3,ki-1
+            DO n2=2,n3-1
+               IF (tabcr(n3) < tabcr(n2)) THEN
+                  tabcr(n2:n3) = (/ tabcr(n3), tabcr(n2:n3-1) /)
+                  tabpt(n2:n3) = (/ tabpt(n3), tabpt(n2:n3-1) /)
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDDO
+         !--- creation des segments
+         DO n2=1,ki-1
+            IF (ABS(tabcr(n2+1)-tabcr(n2)) > v_eps) THEN
+               nsgm = nsgm+1;
+               alfa   = 0.5_rp*(tabcr(n2)+tabcr(n2+1))
+               IF (p_qos(nppol,kpt,tpt,n1,alfa)) THEN
+                  tsgm(nsgm) = segment(tabpt(n2),tabpt(n2+1));
+               ELSE
+                  tsgm(nsgm) = segment(tabpt(n2+1),tabpt(n2));
+               ENDIF
+            ENDIF
+         ENDDO
+      ENDDO
+      !- creation des polygones sans croisement par chainage des segments
+      l_p: &
+         DO n1=1,nsgm
+      !--- recherche du prochain segment disponible
+      IF (tsgm(n1)%ideb <= 0)   CYCLE l_p
+      !--- creation d'un nouveau polygone
+      ipd = tsgm(n1)%ideb; ipc = tsgm(n1)%ifin;
+      tsgm(n1)%ideb = -ipd;
+      pv%n = 2; pv%pt(1:2) = (/ tpt(ipd),tpt(ipc) /);
+      DO
+         !----- recherche du segment suivant
+         ib = 0; cb = HUGE(cb);
+         DO n2=n1+1,nsgm
+            IF (tsgm(n2)%ideb == ipc) THEN
+               c1 =   (tpt(tsgm(n2)%ifin)-pv%pt(pv%n)) &
+                  .a.(pv%pt(pv%n-1)-pv%pt(pv%n))
+               IF (ABS(c1) > v_eps) THEN
+                  IF (    (ib == 0) &
+                     .OR.((cb < 0).AND.(c1 > cb)) &
+                     .OR.((cb > 0).AND.(c1 > 0).AND.(c1 < cb)) ) THEN
+                     ib = n2; cb = c1;
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDDO
+         IF (ib == 0) THEN
+            WRITE (unit=*,fmt='(" chainage interrompu !!!")');
+            CYCLE l_p;
+         ENDIF
+         !-----
+         tsgm(ib)%ideb = -ipc; ipc = tsgm(ib)%ifin;
+         IF (ipc /= ipd) THEN
+            !------- extension du polygone
+            pv%n = pv%n+1; pv%pt(pv%n) = tpt(ipc);
+         ELSE
+            !------- traitement des concavites
+            CALL p_dcv   (pv,npw,pd(npd+1:))
+            npd = npd+npw
+            EXIT
+         ENDIF
+      ENDDO
+   ENDDO l_p
+   !----------------------
+END SUBROUTINE p_dec
+!=
+SUBROUTINE p_dcv   (pg,npd,pd)
+   !---------------------------------------------------------------------
+   !- decomposition d'un polygone sans croisement en polygones convexes
+   !---------------------------------------------------------------------
+   TYPE(polyg) :: pg
+   INTEGER :: npd
+   TYPE(polyg),DIMENSION(:) :: pd
+   !-
+   TYPE(polyg) :: pw
+   TYPE(polyg),DIMENSION((pg%n+1)/2) :: pp
+   INTEGER :: jc,jp,js,np
+   INTEGER :: ks,k0,k1,k2
+   INTEGER :: jw,ii
+   REAL (kind=rp) :: c1,c2,cb
+   TYPE(c2d) :: d1,d2,ptn
+   INTRINSIC huge
+   !---------------------------------------------------------------------
+   npd = 0;
+   !- memorisation et reduction du polygone
+   np = 1; pp(1)%pt(1:pg%n) = pg%pt(1:pg%n); pp(1)%n = pg%n;
+   CALL p_red   (pp(1))
+   !- recherche et des traitements des concavites
+   DO
+      IF (np <= 0) EXIT
+      jc = 0;
+      DO
+         pw = pp(np)
+         jc = jc+1;
+         IF ( (pw%n <= 3).OR.(jc > pw%n) ) EXIT
+         jp = MOD(jc-2+pw%n,pw%n)+1; js = MOD(jc,pw%n)+1;
+         IF ( ((pw%pt(js)-pw%pt(jc)).a.(pw%pt(jp)-pw%pt(jc))) &
+            < -v_eps) THEN
+            !------- traitement d'un rebroussement
+            !------- partage du polygone pw par le segment (jc,jc+1)
+            d1 = pw%pt(MOD(jc,pw%n)+1)-pw%pt(jc);
+            !------- recherche de l'intersection la plus proche
+            ks = 0; cb = HUGE(cb);
+            DO jw=2,pw%n-2
+               k0 = MOD(jc+jw-1,pw%n)+1
+               d2 = pw%pt(MOD(k0,pw%n)+1)-pw%pt(k0)
+               CALL p_i2d (pw%pt(jc),d1,pw%pt(k0),d2,c1,c2,ii)
+               IF (ii > 0) THEN
+                  IF ( (c2 > -v_eps).AND.(c2 < (1.+v_eps)) ) THEN
+                     IF (c1 < v_eps) THEN
+                        IF (ABS(c1) < ABS(cb)) THEN
+                           ks = k0; ptn = pw%pt(k0)+c2*d2; cb = c1;
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+            IF (ks /= 0) THEN
+               !--------- polygones resultants
+               k1 = MIN(jc,ks); k2 = MAX(jc,ks);
+               pp(np)%n = k2-k1+1;
+               pp(np)%pt(1:pp(np)%n) = (/ ptn, pw%pt(k1+1:k2) /);
+               CALL p_red (pp(np));
+               np = np+1;
+               pp(np)%n = k1+1+pw%n-k2;
+               pp(np)%pt(1:pp(np)%n) = &
+                  (/ pw%pt(1:k1), ptn, pw%pt(k2+1:pw%n) /);
+               CALL p_red (pp(np));
+               jc = 0;
+            ELSE
+               WRITE (unit=*,fmt='(" echec !!!")'); STOP
+            ENDIF
+         ENDIF
+      ENDDO
+      npd = npd+1; pd(npd) = pw; np = np-1;
+   ENDDO
+   !----------------------
+END SUBROUTINE p_dcv
+!=
+SUBROUTINE p_apt (point,npt,tpt,kp)
+   !---------------------------------------------------------------------
+   !- recherche de l'index d'un point dans un tableau
+   !- creation de l'element si il n'existe pas
+   !---------------------------------------------------------------------
+   TYPE(c2d) :: point
+   INTEGER :: npt
+   TYPE(c2d),DIMENSION(*) :: tpt
+   INTEGER :: kp
+   !-
+   INTEGER :: i
+   TYPE(c2d) :: ddp
+   !---------------------------------------------------------------------
+   kp = 0
+   DO i=1,npt
+      ddp = point-tpt(i)
+      IF ((ddp.s.ddp) < v_eps) THEN
+         kp = i
+         EXIT
+      ENDIF
+   ENDDO
+   IF (kp == 0) THEN
+      npt = npt+1; kp = npt; tpt(kp) = point;
+   ENDIF
+   !----------------------
+END SUBROUTINE p_apt
+!=
+SUBROUTINE p_i2d (p1,d1,p2,d2,c1,c2,ii)
+   !---------------------------------------------------------------------
+   !- recherche de l'intersection de deux droites
+   !-
+   !-        1  droites secantes
+   !- ii =   0  droites paralleles distinctes
+   !-       -1  droites confondues
+   !---------------------------------------------------------------------
+   TYPE(c2d) :: p1,d1,p2,d2
+   REAL (kind=rp) :: c1,c2
+   INTEGER :: ii
+   !-
+   REAL (kind=rp) :: det
+   TYPE(c2d) :: vp,vn
+   !---------------------------------------------------------------------
+   det = d1.v.d2; vp = p2-p1;
+   IF (ABS(det) > v_eps) THEN
+      ii = 1;
+      c1 = (vp.v.d2)/det; c2 = (vp.v.d1)/det;
+   ELSE
+      ii =  0;
+      vn = c2d(-d1%y,d1%x);
+      det = vn.v.d2;
+      IF (ABS(det) > v_eps) THEN
+         c1 = (vp.v.d2)/det; c2 = (vp.v.vn)/det;
+         IF (ABS(c1) < v_eps) THEN
+            ii = -1;
+         ENDIF
+      ENDIF
+   ENDIF
+   !----------------------
+END SUBROUTINE p_i2d
+!=
+SUBROUTINE p_orp   (pw)
+   !---------------------------------------------------------------------
+   !- orientation d'un polygone (sans croisement)
+   !---------------------------------------------------------------------
+   !- comptage des intersections de la demi-mediatrice orientee
+   !- du segment (pw%n,1) avec le polygone.
+   !- si ce nombre est pair, la demi-mediatrice est exterieure,
+   !- et on inverse le sens du polygone.
+   !---------------------------------------------------------------------
+   TYPE(polyg) :: pw
+   !-
+   INTEGER :: i,ii,nic,issp,issc
+   REAL (kind=rp) :: c1,c2
+   TYPE(c2d) :: pm,vt,vn,vw
+
+!$$$   integer :: ntoto = 0
+   !---------------------------------------------------------------------
+   pm = 0.5_rp*(pw%pt(pw%n)+pw%pt(1));
+   vt = pw%pt(1)-pw%pt(pw%n);
+   vn = c2d(-vt%y,vt%x);
+   !-
+   nic = 0; issp = 0;
+   DO i=1,pw%n-1
+      vw  = pw%pt(i+1)-pw%pt(i);
+      CALL p_i2d   (pm,vn,pw%pt(i),vw,c1,c2,ii)
+      IF (ii > 0) THEN
+!$$$$$ if (c1 > 0.) then
+         IF (c1 > -v_eps) THEN
+            IF      ( (c2 >  v_eps).AND.(c2 < (1.-v_eps)) ) THEN
+               !--------- la normale passe par l'interieur du cote (i,i+1)
+               nic = nic+1
+               issp = 0;
+            ELSE IF ( (c2 > -v_eps).AND.(c2 < (1.+v_eps)) ) THEN
+               !--------- la normale passe par le sommet i
+               issc = NINT(SIGN(1.,vw.s.vt));
+               IF ((issc*issp) > 0) THEN
+                  nic = nic+1
+               ENDIF
+               issp = issc;
+            ENDIF
+         ENDIF
+      ENDIF
+   ENDDO
+   !-
+   IF (MOD(nic,2) == 0) THEN
+!$$$     write  (unit=*,fmt='(" inversion du sens du polygone")');
+!$$$     ntoto = ntoto + 1
+!$$$     write  (unit=*,fmt=*) pw%pt(1:pw%n:1)
+!$$$     if ( ntoto > 4 ) stop
+      pw%pt(1:pw%n:1) = pw%pt(pw%n:1:-1);
+!$$$   else
+!$$$     write  (unit=*,fmt='(" sens correct")');
+   ENDIF
+   !----------------------
+END SUBROUTINE p_orp
+!=
+LOGICAL FUNCTION p_qos   (nppol,kpt,tpt,isc,alfa)
+   !---------------------------------------------------------------------
+   !- test d'orientation d'un segment de polygone
+   !---------------------------------------------------------------------
+   !- comptage des intersections de la demi-mediatrice orientee
+   !- du segment (isc,isc+alpha*longueur(isc)) avec le polygone.
+   !- si ce nombre est pair, la demi-mediatrice est exterieure,
+   !- et le polygone est mal oriente.
+   !---------------------------------------------------------------------
+   INTEGER :: nppol
+   INTEGER,DIMENSION(*) :: kpt
+   TYPE(c2d),DIMENSION(*) :: tpt
+   INTEGER :: isc
+   REAL (kind=rp) :: alfa
+   !-
+   INTEGER :: i,ii,nic,issp,issc,isd
+   REAL (kind=rp) :: c1,c2
+   TYPE(c2d) :: ptm,pts,normale,segment
+   !---------------------------------------------------------------------
+   ptm = tpt(kpt(isc))+alfa*(tpt(kpt(MOD(isc,nppol)+1))-tpt(kpt(isc)));
+   segment = ptm-tpt(kpt(isc));
+   normale%x = -segment%y; normale%y = segment%x;
+   !-
+   nic = 0; issp = 0;
+   DO i=0,nppol-2
+      isd = MOD(isc+i,nppol)+1
+      pts  = tpt(kpt(MOD(isd,nppol)+1))-tpt(kpt(isd));
+      CALL p_i2d   (ptm,normale,tpt(kpt(isd)),pts,c1,c2,ii)
+      IF (ii > 0) THEN
+         IF (c1 > 0.) THEN
+            IF      ( (c2 > v_eps).AND.(c2 < (1.-v_eps)) ) THEN
+               !--------- la normale passe par l'interieur du cote (isd,isd+1)
+               nic = nic+1
+               issp = 0;
+            ELSE IF ( (c2 > -v_eps).AND.(c2 < (1.+v_eps)) ) THEN
+               !--------- la normale passe par le sommet isd
+               issc = NINT(SIGN(1.,pts.s.segment));
+               IF ((issc*issp) > 0) THEN
+                  nic = nic+1
+               ENDIF
+               issp = issc;
+            ENDIF
+         ENDIF
+      ENDIF
+   ENDDO
+   !-
+   p_qos = (MOD(nic,2) /= 0)
+   !--------------------
+END FUNCTION p_qos
+!=
+SUBROUTINE p_pcp   (p1,p2,p3)
+   !---------------------------------------------------------------------
+   !- polygone commun a 2 polygones convexes orientes
+   !---------------------------------------------------------------------
+   TYPE(polyg) :: p1,p2,p3
+   !-
+   TYPE(polyg),DIMENSION(2) :: pw
+   INTEGER :: j1d,j1f,j2d,j2f
+   INTEGER :: kc,kr
+   INTEGER :: ipd,ipf
+   TYPE(c2d) :: v1,v2
+   REAL (kind=rp) :: ww
+   !---------------------------------------------------------------------
+   !- copie du polygone p1 dans le polygone candidat
+   kc = 1; pw(kc)%n = p1%n; pw(kc)%pt(1:pw(kc)%n) = p1%pt(1:pw(kc)%n);
+   !- decoupage du polygone candidat par chaque cote de p2
+   j2d = p2%n;
+   l_r: &
+      DO j2f=1,p2%n
+   !--- definition du polygone resultat
+   kr = 3-kc; pw(kr)%n = 0;
+   !--- definition du vecteur decoupant
+   v2 = p2%pt(j2f)-p2%pt(j2d);
+   !--- traitement des cotes successifs du polygone candidat
+   j1d = pw(kc)%n;
+   !--- position relative (origine segment candidat)/(segment decoupant)
+   ipd = n_sgn(v2.v.(pw(kc)%pt(j1d)-p2%pt(j2d)))
+   DO j1f=1,pw(kc)%n
+      !----- definition du vecteur candidat
+      v1 = pw(kc)%pt(j1f)-pw(kc)%pt(j1d);
+      !----- position relative (fin segment candidat)/(segment decoupant)
+      ipf = n_sgn(v2.v.(pw(kc)%pt(j1f)-p2%pt(j2d)))
+      !----- si l'origine appartient au cote decoupant ou est du bon cote,
+      !----- on l'insere dans le nouveau polygone candidat
+      IF (ipd >= 0) THEN
+         pw(kr)%n = pw(kr)%n+1
+         pw(kr)%pt(pw(kr)%n) = pw(kc)%pt(j1d)
+      ENDIF
+      !----- si le segment candidat est coupe par le segment decoupant,
+      !----- on introduit l'intersection dans le polygone resultat
+      IF ((ipd*ipf) < 0) THEN
+         pw(kr)%n = pw(kr)%n+1
+         ww  = (v2.v.(pw(kc)%pt(j1d)-p2%pt(j2d)))/(v1.v.v2)
+         pw(kr)%pt(pw(kr)%n) = pw(kc)%pt(j1d)+ww*v1
+      ENDIF
+      !----- l'extremite du segment sera l'origine du segment suivant
+      ipd = ipf; j1d = j1f;
+   ENDDO
+   !--- si le polygone resultat est degenere, il n'y a pas de recouvrement
+   IF (pw(kr)%n < 3)   EXIT l_r
+   !--- le polygone resultat devient polygone candidat
+   kc = kr;
+   !--- passage au cote suivant de p2
+   j2d = j2f;
+ENDDO l_r
+!- fin de decoupage : rangement du resultat dans p3
+IF (pw(kr)%n < 3) THEN
+   p3%n = 0
+ELSE
+   p3%n = pw(kr)%n
+   p3%pt(1:p3%n) = pw(kr)%pt(1:pw(kr)%n)
+ENDIF
+!----------------------
+END SUBROUTINE p_pcp
+!=
+SUBROUTINE p_red (p0)
+   !---------------------------------------------------------------------
+   !- reduction d'un polygone
+   !- suppression des doublons et alignements
+   !---------------------------------------------------------------------
+TYPE(polyg) :: p0
+!-
+INTEGER :: ip,ic,is
+TYPE(c2d) :: dp,ds
+!---------------------------------------------------------------------
+ic = 1;
+DO
+   IF ( (p0%n < 3).OR.(ic > p0%n) ) EXIT
+   ip = MOD(ic-2+p0%n,p0%n)+1; is = MOD(ic,p0%n)+1;
+   dp = p0%pt(ic)-p0%pt(ip); ds = p0%pt(is)-p0%pt(ic);
+!$$$ if      ((dp.s.dp) < v_eps) then
+!$$$   p0%pt(ip:p0%n-1) = p0%pt(ip+1:p0%n); p0%n = p0%n-1;
+!$$$ else if ((ds.s.ds) < v_eps) then
+!$$$   p0%pt(is:p0%n-1) = p0%pt(is+1:p0%n); p0%n = p0%n-1;
+!$$$ else if (abs(dp.v.ds) < v_eps) then
+   IF (ABS(dp.v.ds) < v_eps) THEN
+      p0%pt(ic:p0%n-1) = p0%pt(ic+1:p0%n); p0%n = p0%n-1;
+      ic = MAX(ic-1,1);
+   ELSE
+      ic = ic+1;
+   ENDIF
+ENDDO
+!----------------------
+END SUBROUTINE p_red
+!=
+INTEGER FUNCTION n_sgn (v)
+   !---------------------------------------------------------------------
+   REAL (kind=rp):: v
+   !---------------------------------------------------------------------
+   IF      (v >  v_eps) THEN
+      n_sgn =  1
+   ELSE IF (v < -v_eps) THEN
+      n_sgn = -1
+   ELSE
+      n_sgn =  0
+   ENDIF
+   !--------------------
+END FUNCTION n_sgn
+!=
+FUNCTION p_srf   (pw)
+   !---------------------------------------------------------------------
+   !- calcul de la surface d'un polygone (sans croisement)
+   !---------------------------------------------------------------------
+   !- sommation des surfaces des triangles orientes composant le polygone
+   !---------------------------------------------------------------------
+   REAL (kind=rp) :: p_srf
+   TYPE(polyg) :: pw
+   !-
+   INTEGER :: j1,j2,j3,jp
+   !---------------------------------------------------------------------
+   p_srf = 0.0_rp ; j1 = 1;
+   DO jp=1,pw%n-2
+      j2 = jp+1; j3 = jp+2;
+      p_srf = p_srf+((pw%pt(j2)-pw%pt(j1)).v.(pw%pt(j3)-pw%pt(j1)))
+   ENDDO
+   p_srf = 0.5_rp * ABS(p_srf)
+   !--------------------
+END FUNCTION p_srf
+!=
+INTEGER FUNCTION p_tap   (pq,pw)
+   !---------------------------------------------------------------------
+   !- test d'appartenance d'un point a un polygone
+   !---------------------------------------------------------------------
+   !- calcul du nombre d'intersections de la demi-droite perpendiculaire
+   !- au premier cote avec les autres cotes.
+   !- si ce nombre est pair, le point appartient au polygone.
+   !---------------------------------------------------------------------
+   TYPE(c2d) :: pq
+   TYPE(polyg) :: pw
+   !-
+   INTEGER :: jp,ii,nic,issp,issc
+   REAL (kind=rp)   :: c1,c2
+   TYPE(c2d) :: vq,vs
+   !---------------------------------------------------------------------
+   nic = 0; issp = 0;
+vq  = c2d(pw%pt(1)%y-pw%pt(2)%y,pw%pt(2)%x-pw%pt(1)%x)
+DO jp=1,pw%n
+   vs   = pw%pt(MOD(jp,pw%n)+1)-pw%pt(jp)
+   CALL p_i2d   (pq,vq,pw%pt(jp),vs,c1,c2,ii)
+   IF (ii > 0) THEN
+      !----- la demi-droite coupe un cote
+      IF (c1 > v_eps) THEN
+         !------- le point est externe a la droite portant le cote
+         IF      ( (c2 > v_eps).AND.(c2 < (1.-v_eps)) ) THEN
+            !--------- la demi-droite passe par l'interieur du cote
+            nic = nic+1
+            issp = 0;
+         ELSE IF ( (c2 > -v_eps).AND.(c2 < (1.+v_eps)) ) THEN
+            !--------- la demi-droite passe par un sommet
+            issc = NINT(SIGN(1.,vq.s.vs));
+            IF ((issc*issp) < 0) THEN
+               nic = nic+1
+               issp = 0;
+            ENDIF
+            issp = issc;
+         ENDIF
+      ELSE IF (ABS(c1) < v_eps) THEN
+         !------- le point est sur la droite portant le cote
+         IF ( (c2 > -v_eps).AND.(c2 < (1.+v_eps)) ) THEN
+            !--------- le point appartient au cote
+            nic = -1
+            EXIT
+         ENDIF
+      ENDIF
+   ELSE IF (ii < 0) THEN
+      !----- la demi-droite est colineaire a un cote
+      IF ( (c2 > -v_eps).AND.(c2 < (1.+v_eps)) ) THEN
+         nic = -1
+         EXIT
+      ENDIF
+   ENDIF
+ENDDO
+!-
+p_tap = MOD(nic,2)
+!--------------------
+END FUNCTION p_tap
+!=
+!-----------------
+END MODULE u_polyg
Index: /TOOLS/MOZAIC/util/allwei.job
===================================================================
--- /TOOLS/MOZAIC/util/allwei.job	(revision 3326)
+++ /TOOLS/MOZAIC/util/allwei.job	(revision 3326)
@@ -0,0 +1,80 @@
+#!/bin/bash
+######################
+## CESIUM   CEA ##
+######################
+#MSUB -r allwei         # Nom du job                
+#MSUB -n 1              # Reservation du processus
+#MSUB -N 1              # Reservation du noeud
+#MSUB -T 86400          # Limite de temps elapsed du job
+#MSUB -e allwei.out     # Sortie standard
+#MSUB -o allwei.out     # Sortie standard
+#MSUB -q xlarge 
+#MSUB -Q normal
+#MSUB -p gen2211
+
+module list
+  
+set -vx
+
+SUBMIT_DIR=${SUBMIT_DIR:-${BRIDGE_MSUB_PWD:-${PWD}}}
+JOB_ID=${BRIDGE_MSUB_JOBID:-${$}}
+
+RESOL=$(basename ${SUBMIT_DIR})
+RESOL_DIR=${SUBMIT_DIR}
+#RESOL=ORCA1xLMD9695
+#RESOL_DIR=${DMFDIR}/CPL/FILES/${RESOL}
+
+TMPDIR=${SCRATCHDIR}/${RESOL}.${JOB_ID}
+mkdir -p ${TMPDIR} || exit 1
+cd ${TMPDIR} || exit 2
+
+echo RESOL : ${RESOL}
+RESOL_OCE=$(echo ${RESOL} | sed 's/x.*//' | sed 's/ORCA//' )
+RESOL_ATM=$(echo ${RESOL} | sed 's/.*x//' | sed 's/LMD//'  )
+echo RESOL OCE : ${RESOL_OCE}
+echo RESOL ATM : ${RESOL_ATM}
+
+# ==============================================
+pwd
+
+cp ${HOME}/CPL/MOZAIC/util/*.sh .
+cp ${HOME}/CPL/MOZAIC/bin/*.exe .
+
+cp ${RESOL_DIR}/run.def .
+cp ${RESOL_DIR}/orca${RESOL_OCE}.*.nc .
+# cp ${RESOL_DIR}/grids.nc .
+# cp ${RESOL_DIR}/masks.nc .
+# cp ${RESOL_DIR}/areas.nc .
+# cp ${RESOL_DIR}/o2a.diag.nc .
+# cp ${RESOL_DIR}/mozaic.wo2a.* .
+# cp ${RESOL_DIR}/mozaic.wa2o.* .
+
+ls -al
+
+time ./allgrid.sh -c ${RESOL}
+time ./mosaic.exe     > mosaic.out      2>&1
+time ./allgrid.sh -c -r ${RESOL}
+#time ./cotes.exe      > cotes.out       2>&1 
+time ./cotes_etal.exe > cotes_etal.out  2>&1 
+time ./icestream.exe  > icestream.out   2>&1
+time ./tst.exe        > tst.out         2>&1
+time ./tst.exe -r     > tst_r.out       2>&1
+
+date
+
+ls -al
+
+chmod a+r *
+
+cp  *.out \
+    LMDZ4.0_*_grid.nc \
+    a2o.* o2a.* itarget.nc \
+    areas.nc masks.nc grids.nc \
+    dist_cote.nc flux_iceberg \
+    lmd.*.r8 lmd.*.i4 lmd.*.i8 lmdz.*.nc \
+    mozaic.*.nc mozaic.*r8 \
+    poly.* \
+    ${RESOL_DIR}
+
+# ==============================================
+
