Index: IOIPSL/tags/v2_1_9/IOIPSL_License_CeCILL.txt
===================================================================
--- IOIPSL/tags/v2_1_9/IOIPSL_License_CeCILL.txt	(revision 715)
+++ IOIPSL/tags/v2_1_9/IOIPSL_License_CeCILL.txt	(revision 715)
@@ -0,0 +1,36 @@
+The following licence information concerns ONLY the IOIPSL directory
+====================================================================
+
+Copyright (C) Institut Pierre Simon Laplace : IPSL
+
+This software is composed by a set of subroutines working as an
+interface between climate models and NETCDF files following CF
+convention. Library sources, examples of use and tools based on
+IOIPSL are provided. This library requires NetCDF library :
+http://www.unidata.ucar.edu/software/netcdf/
+
+This software is governed by the CeCILL license under French law and
+abiding by the rules of distribution of free software. You can use,
+modify and/or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info".
+
+As a counterpart to the access to the source code and rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty and the software's author, the holder of the
+economic rights, and the successive licensors have only limited
+liability.
+
+In this respect, the user's attention is drawn to the risks associated
+with loading, using, modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean that it is complicated to manipulate, and that also
+therefore means that it is reserved for developers and experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or
+data to be ensured and, more generally, to use and operate it in the
+same conditions as regards security.
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
Index: IOIPSL/tags/v2_1_9/example/AA_make
===================================================================
--- IOIPSL/tags/v2_1_9/example/AA_make	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/AA_make	(revision 715)
@@ -0,0 +1,333 @@
+#-
+#- $Id$
+#-
+USER_DIR = $(shell /bin/pwd)
+MAKE_DIR = '??'
+ifneq ($(USER_DIR),$(MAKE_DIR))
+ @$(error You must invoke this Makefile from its directory)
+endif
+#-
+IOIPSL_LIB = -L$(LIBDIR) -lioipsl
+ifeq ($(L_X),1)
+IOIPSL_LIB = -L$(LIBDIR) -lsxioipsl
+endif
+#-
+all: testhist1 testhist2 testrest testopp testcalendar testflio
+	echo don t forget to do : $(M_K) clean !!!
+
+testhist1:
+	$(M_K) libioipsl
+	$(M_K) testhist1.x
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testhist1
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testhist1
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testhist1
+#-Q- sx8mercure	echo '\
+	./testhist1.x \
+#-Q- sx8brodie ' >> Job_testhist1
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testhist1 Job_testhist1
+#-Q- sx8brodie	echo job Job_testhist1 has been submitted
+#-Q- sx6nec ' >> Job_testhist1
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testhist1 Job_testhist1
+#-Q- sx6nec	echo job Job_testhist1 has been submitted
+#-Q- sx8mercure ' >> Job_testhist1
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testhist1 Job_testhist1
+#-Q- sx8mercure	echo job Job_testhist1 has been submitted
+
+	@echo ' '
+	@echo 'file testhist1.nc should be created'
+	@echo 'to see it, type : ncdump -h testhist1.nc'
+	@echo ' '
+
+testhist1.x: testhist1.o
+	$(F_L) -o testhist1.x testhist1.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testhist2:
+	$(M_K) libioipsl
+	$(M_K) testhist2.x
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testhist2
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testhist2
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testhist2
+#-Q- sx8mercure	echo '\
+	./testhist2.x \
+#-Q- sx8brodie ' >> Job_testhist2
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testhist2 Job_testhist2
+#-Q- sx8brodie	echo job Job_testhist2 has been submitted
+#-Q- sx6nec ' >> Job_testhist2
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testhist2 Job_testhist2
+#-Q- sx6nec	echo job Job_testhist2 has been submitted
+#-Q- sx8mercure ' >> Job_testhist2
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testhist2 Job_testhist2
+#-Q- sx8mercure	echo job Job_testhist2 has been submitted
+
+	@echo ' '
+	@echo 'file testhist2.nc should be created'
+	@echo 'to see it, type : ncdump -h testhist2.nc'
+	@echo ' '
+	@echo 'file testhist2_bis.nc should be created'
+	@echo 'to see it, type : ncdump -h testhist2_bis.nc'
+	@echo ' '
+
+testhist2.x: testhist2.o
+	$(F_L) -o testhist2.x testhist2.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testrest:
+	$(M_K) libioipsl
+	$(M_K) testrest.x
+	$(RM) restfile.nc restfilebis.nc
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testrest
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testrest
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testrest
+#-Q- sx8mercure	echo '\
+	./testrest.x \
+#-Q- sx8brodie ' >> Job_testrest
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testrest Job_testrest
+#-Q- sx8brodie	echo job Job_testrest has been submitted
+#-Q- sx6nec ' >> Job_testrest
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testrest Job_testrest
+#-Q- sx6nec	echo job Job_testrest has been submitted
+#-Q- sx8mercure ' >> Job_testrest
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testrest Job_testrest
+#-Q- sx8mercure	echo job Job_testrest has been submitted
+
+	@echo ' '
+	@echo 'file restfile.nc should be created'
+	@echo 'to see it, type : ncdump -h restfile.nc'
+	@echo ' '
+	@echo 'file restfilebis.nc should be created'
+	@echo 'to see it, type : ncdump -h restfilebis.nc'
+	@echo ' '
+
+testrest.x: testrest.o
+	$(F_L) -o testrest.x testrest.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testopp:
+	$(M_K) libioipsl
+	$(M_K) testopp.x
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testopp
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testopp
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testopp
+#-Q- sx8mercure	echo '\
+	./testopp.x \
+#-Q- sx8brodie ' >> Job_testopp
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testopp Job_testopp
+#-Q- sx8brodie	echo job Job_testopp has been submitted
+#-Q- sx6nec ' >> Job_testopp
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testopp Job_testopp
+#-Q- sx6nec	echo job Job_testopp has been submitted
+#-Q- sx8mercure ' >> Job_testopp
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testopp Job_testopp
+#-Q- sx8mercure	echo job Job_testopp has been submitted
+
+testopp.x: testopp.o
+	$(F_L) -o testopp.x testopp.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testcalendar:
+	$(M_K) libioipsl
+	$(M_K) testcalendar.x
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testcalendar
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testcalendar
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testcalendar
+#-Q- sx8mercure	echo '\
+	echo; \
+#-Q- sx8brodie ' >> Job_testcalendar
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec ' >> Job_testcalendar
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure ' >> Job_testcalendar
+#-Q- sx8mercure	echo '\
+        ./testcalendar.x; \
+#-Q- sx8brodie ' >> Job_testcalendar
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec ' >> Job_testcalendar
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure ' >> Job_testcalendar
+#-Q- sx8mercure	echo '\
+        echo; \
+#-Q- sx8brodie ' >> Job_testcalendar
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec ' >> Job_testcalendar
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure ' >> Job_testcalendar
+#-Q- sx8mercure	echo '\
+        ./testcalendar.x noleap; \
+#-Q- sx8brodie ' >> Job_testcalendar
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec ' >> Job_testcalendar
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure ' >> Job_testcalendar
+#-Q- sx8mercure	echo '\
+        echo; \
+#-Q- sx8brodie ' >> Job_testcalendar
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec ' >> Job_testcalendar
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure ' >> Job_testcalendar
+#-Q- sx8mercure	echo '\
+        ./testcalendar.x 360d; \
+#-Q- sx8brodie ' >> Job_testcalendar
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testcalendar Job_testcalendar
+#-Q- sx8brodie	echo job Job_testcalendar has been submitted
+#-Q- sx6nec ' >> Job_testcalendar
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testcalendar Job_testcalendar
+#-Q- sx6nec	echo job Job_testcalendar has been submitted
+#-Q- sx8mercure ' >> Job_testcalendar
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testcalendar Job_testcalendar
+#-Q- sx8mercure	echo job Job_testcalendar has been submitted
+
+testcalendar.x: testcalendar.o
+	$(F_L) -o testcalendar.x testcalendar.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testflio:
+	$(M_K) libioipsl
+	$(M_K) testflio.x
+
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testflio
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testflio
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testflio
+#-Q- sx8mercure	echo '\
+	./testflio.x \
+#-Q- sx8brodie ' >> Job_testflio
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testflio Job_testflio
+#-Q- sx8brodie	echo job Job_testflio has been submitted
+#-Q- sx6nec ' >> Job_testflio
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testflio Job_testflio
+#-Q- sx6nec	echo job Job_testflio has been submitted
+#-Q- sx8mercure ' >> Job_testflio
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testflio Job_testflio
+#-Q- sx8mercure	echo job Job_testflio has been submitted
+
+	@echo ' '
+	@echo 'file testflio_0001.nc should be created'
+	@echo 'to see it, type : ncdump -h testflio_0001.nc'
+	@echo ' '
+
+testflio.x: testflio.o
+	$(F_L) -o testflio.x testflio.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testconfig:
+	$(M_K) libioipsl
+	$(M_K) testconfig.x
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testconfig
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testconfig
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testconfig
+#-Q- sx8mercure	echo '\
+	./testconfig.x \
+#-Q- sx8brodie ' >> Job_testconfig
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testconfig Job_testconfig
+#-Q- sx8brodie	echo job Job_testconfig has been submitted
+#-Q- sx6nec ' >> Job_testconfig
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testconfig Job_testconfig
+#-Q- sx6nec	echo job Job_testconfig has been submitted
+#-Q- sx8mercure ' >> Job_testconfig
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testconfig Job_testconfig
+#-Q- sx8mercure	echo job Job_testconfig has been submitted
+
+testconfig.x: testconfig.o
+	$(F_L) -o testconfig.x testconfig.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+testconfig2:
+	$(M_K) libioipsl
+	$(M_K) testconfig2.x
+#-Q- sx8brodie	echo cd $(USER_DIR) > Job_testconfig2
+#-Q- sx8brodie	echo '\
+#-Q- sx6nec	echo cd $(USER_DIR) > Job_testconfig2
+#-Q- sx6nec	echo '\
+#-Q- sx8mercure	echo cd $(USER_DIR) > Job_testconfig2
+#-Q- sx8mercure	echo '\
+	./testconfig2.x \
+#-Q- sx8brodie ' >> Job_testconfig2
+#-Q- sx8brodie	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8brodie	 -o $(USER_DIR)/Out_testconfig2 Job_testconfig2
+#-Q- sx8brodie	echo job Job_testconfig2 has been submitted
+#-Q- sx6nec ' >> Job_testconfig2
+#-Q- sx6nec	qsub -j o -S /usr/bin/ksh \
+#-Q- sx6nec	 -o $(USER_DIR)/Out_testconfig2 Job_testconfig2
+#-Q- sx6nec	echo job Job_testconfig2 has been submitted
+#-Q- sx8mercure ' >> Job_testconfig2
+#-Q- sx8mercure	qsub -j o -S /usr/bin/ksh \
+#-Q- sx8mercure	 -o $(USER_DIR)/Out_testconfig2 Job_testconfig2
+#-Q- sx8mercure	echo job Job_testconfig2 has been submitted
+
+testconfig2.x: testconfig2.o
+	$(F_L) -o testconfig2.x testconfig2.o \
+               $(L_O) $(IOIPSL_LIB) $(NCDF_LIB)
+
+config: libioipsl
+	(cd ../src; $(M_K) -f Makefile config)
+	$(BINDIR)/Fparser -main -name testconfig testconfig.f90
+	$(SCPDIR)/build_tkmenus
+	./config.tk
+	$(RM) Config.*
+
+libioipsl:
+	(cd ../src; $(M_K) -f Makefile)
+
+clean:
+	$(RM) *.*~ Makefile~ core *.o *.nc Out_t* Job_t* *.x *_run.def
+
+testhist1.o: testhist1.f90
+	$(F_C) $(F_O) testhist1.f90
+
+testhist2.o: testhist2.f90
+	$(F_C) $(F_O) testhist2.f90
+
+testrest.o: testrest.f90
+	$(F_C) $(F_O) testrest.f90
+
+testopp.o: testopp.f90
+	$(F_C) $(F_O) testopp.f90
+
+testcalendar.o: testcalendar.f90
+	$(F_C) $(F_O) testcalendar.f90
+
+testflio.o: testflio.f90
+	$(F_C) $(F_O) testflio.f90
+
+testconfig.o: testconfig.f90
+	$(F_C) $(F_O) testconfig.f90
+
+testconfig2.o: testconfig2.f90
+	$(F_C) $(F_O) testconfig2.f90
+
Index: IOIPSL/tags/v2_1_9/example/AA_make.ldef
===================================================================
--- IOIPSL/tags/v2_1_9/example/AA_make.ldef	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/AA_make.ldef	(revision 715)
@@ -0,0 +1,13 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Samples related to IOIPSL
+#---------------------------------------------------------------------
+SHELL = /bin/ksh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+SCPDIR = ../../../scripts
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
Index: IOIPSL/tags/v2_1_9/example/testcalendar.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testcalendar.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testcalendar.f90	(revision 715)
@@ -0,0 +1,70 @@
+PROGRAM testcalendar
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This program will do some basic tests on the calendar
+!---------------------------------------------------------------------
+  USE calendar
+!-
+  IMPLICIT NONE
+!-
+  REAL :: julian, sec
+  INTEGER :: year, month, day
+  INTEGER :: iread, iret
+  CHARACTER(LEN=20) :: tmp
+!-
+  INTEGER :: iargc, getarg
+  EXTERNAL iargc, getarg
+!---------------------------------------------------------------------
+!-
+! Get the command line arguments
+!-
+  iread = iargc()
+  IF (iread .EQ. 0) THEN
+    WRITE(*,*) 'Using the default calendar'
+  ELSE
+    iret = getarg(1,tmp)
+    WRITE(*,*) 'Using the calendar named :',TRIM(tmp)
+    CALL ioconf_calendar (TRIM(tmp))
+  ENDIF
+!-
+! Get the origine of the julian days
+!-
+  julian = 0.0
+  CALL ju2ymds (julian, year, month, day, sec)
+  WRITE(*,*) 'Day at which the julian day was zero :'
+  WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day
+!-
+! Do we get the same day back when we go back and forth
+!-
+  year = 1997
+  month = 8
+  day = 21
+  sec = 0.0
+  WRITE(*,*) 'Day transformed into julian :'
+  WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day
+  CALL ymds2ju (year, month, day, sec, julian)
+  WRITE(*,*) ' --> The resulting julian day : ',julian
+  CALL ju2ymds (julian, year, month, day, sec)
+  WRITE(*,*) 'The day which comes out again :'
+  WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day
+!-
+! Yet another test but this time with a strange dat !
+!-
+  year = 1997
+  month = 3
+  day = 34
+  sec = 0.0
+  WRITE(*,*) 'Strange day transformed into julian :'
+  WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day
+  CALL ymds2ju (year, month, day, sec, julian)
+  WRITE(*,*) ' --> The resulting julian day : ',julian
+  CALL ju2ymds (julian, year, month, day, sec)
+  WRITE(*,*) &
+ &  'The day which comes out again, does it make more sense ? :'
+  WRITE(*,*) 'Year : ',year,' Month : ',month,' Day : ',day
+!-----------------------
+END PROGRAM testcalendar
Index: IOIPSL/tags/v2_1_9/example/testconfig.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testconfig.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testconfig.f90	(revision 715)
@@ -0,0 +1,98 @@
+PROGRAM testconfig
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+  !
+  USE getincom
+  !
+  !
+  !      This program will do some basic tests on the getin module
+  !
+  !
+  IMPLICIT NONE
+  !
+  LOGICAL           :: debug
+  CHARACTER(LEN=80) :: filename
+  CHARACTER(LEN=10), DIMENSION(3) :: strvec
+  INTEGER           :: split
+  REAL              :: g
+  REAL, DIMENSION(3) :: realvec
+  !
+  !-
+  !- set debug to have more information
+  !-
+  !Config  Key  = DEBUG_INFO
+  !Config  Desc = Flag for debug information
+  !Config  Def  = n
+  !Config  Help = This option allows to switch on the output of debug
+  !Config         information without recompiling the code.
+  !-
+  debug = .FALSE.
+  CALL getin('DEBUG_INFO',debug) 
+  !
+  !Config  Key  = FORCING_FILE
+  !Config  Desc = Name of file containing the forcing data
+  !Config  Def  = islscp_for.nc
+  !Config  Help = This is the name of the file which should be opened
+  !Config         for reading the forcing data of the dim0 model.
+  !Config         The format of the file has to be netCDF and COADS
+  !Config         compliant.
+  !-
+  filename='islscp_for.nc'
+  CALL getin('FORCING_FILE',filename)
+  !
+  !
+  !Config  Key  = SPLIT_DT
+  !Config  Desc = splits the timestep imposed by the forcing
+  !Config  Def  = 12
+  !Config  Help = With this value the time step of the forcing
+  !Config         will be devided. In principle this can be run
+  !Config         in explicit mode but it is strongly suggested
+  !Config         to use the implicit method so that the
+  !Config         atmospheric forcing has a smooth evolution.
+  !-
+  split = 12
+  CALL getin('SPLIT_DT', split)
+  !
+  !
+  !Config  Key  = GRAVIT
+  !Config  Desc = Gravitation constant
+  !Config  Def  = 9.98
+  !Config  Help = In theory these parameters could also be defined through
+  !Config         this mechanisme to ensure that the same value is used by
+  !Config         all components of the model.
+  !-
+  g = 9.98
+  CALL getin('GRAVIT', g)
+  !
+  !Config  Key  = WORDS
+  !Config  Desc = A vector of words
+  !Config  Def  = here there anywhere
+  !Config  Help = An example for a vector of strings
+  !-
+  strvec(1) = "here"
+  strvec(2) = "there"
+  strvec(3) = "anywhere"
+  CALL getin('WORDS', strvec)
+  !
+  !Config  Key  = VECTOR
+  !Config  Desc = A vector of reals
+  !Config  Def  = 1, 2, 3
+  !Config  Help = An example for a vector of REALs
+  !-
+  realvec=(/1,2,3/)
+  CALL getin('VECTOR', realvec)
+  !
+  WRITE(*,*) 'From the run.def we have extracted the following information :'
+  WRITE(*,*) 'DEBUG : ', debug
+  WRITE(*,*) 'FILENAME : ', filename(1:len_trim(filename))
+  WRITE(*,*) 'SPLIT : ', split
+  WRITE(*,*) 'G : ', g
+  WRITE(*,*) 'WORDS : ', strvec
+  WRITE(*,*) 'VECTOR : ', realvec
+  !
+  CALL getin_dump()
+  !
+END PROGRAM testconfig
Index: IOIPSL/tags/v2_1_9/example/testconfig2.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testconfig2.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testconfig2.f90	(revision 715)
@@ -0,0 +1,486 @@
+PROGRAM testconfig2
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+  !
+  USE getincom
+  !
+  !
+  !      This program will do some basic tests on the getin module
+  !
+  !
+  IMPLICIT NONE
+  !
+  INTEGER :: dayref=181
+  INTEGER :: anneeref = 1998
+  INTEGER :: nday = 10
+  INTEGER :: day_step = 240 
+  INTEGER :: iperiod = 5
+  INTEGER :: iconser = 240  
+  INTEGER :: iecri = 1
+  INTEGER :: idissip = 10
+  INTEGER :: nitergdiv = 1
+  INTEGER :: nitergrot = 2
+  INTEGER :: niterh = 2
+  INTEGER :: iphysiq = 5
+  INTEGER :: ecritphy = 1
+  INTEGER :: nbapp_rad = 12
+  INTEGER :: iflag_con = 2
+
+  REAL :: periodav = 1.
+  REAL :: tetagdiv = 7200.
+  REAL :: tetagrot = 7200.
+  REAL :: tetatemp  = 7200.
+  REAL :: coefdis = 0.
+  REAL :: clonn = 0.
+  REAL :: clatt = 0.
+  REAL :: grossismxx = 1.0
+  REAL :: grossismyy = 1.0
+  REAL :: dzoomxx = 0.0
+  REAL :: dzoomyy = 0.0
+  REAL :: tauxx = 3.0
+  REAL :: tauyy = 3.0
+  REAL :: clon = 0.
+  REAL :: clat = 0.
+  REAL :: grossismx = 1.0
+  REAL :: grossismy = 1.0
+  REAL :: dzoomx = 0.0
+  REAL :: dzoomy = 0.0
+  REAL :: taux = 3.0
+  REAL :: tauy = 3.0
+
+  LOGICAL :: lstardis = .TRUE.
+  LOGICAL :: purmats = .FALSE.
+  LOGICAL :: physic = .TRUE.
+  LOGICAL :: cycle_diurne = .TRUE.
+  LOGICAL :: soil_model = .TRUE.
+  LOGICAL :: new_oliq = .TRUE.
+  LOGICAL :: ok_orodr = .TRUE.
+  LOGICAL :: ok_orolf = .TRUE.
+  LOGICAL :: ok_limitvrai = .FALSE.
+  LOGICAL :: fxyhypbb = .TRUE.
+  LOGICAL :: ysinuss = .TRUE.
+  LOGICAL :: fxyhypb = .TRUE.
+  LOGICAL :: ysinus = .TRUE.
+!
+! For time keeping
+!
+  INTEGER :: date_time(8), date_start, date_end
+  CHARACTER(LEN=10) big_ben(3)
+!
+!
+!
+  CALL DATE_AND_TIME(big_ben(1), big_ben(2), big_ben(3), date_time)
+  date_start = date_time(8) + 1000*date_time(7) + 60*1000*date_time(7)
+!
+!Config  Key  = dayref
+!Config  Desc = Jour de l'etat initial
+!Config  Def  = 181
+!Config  Help = Jour de l'etat initial ( = 350  si 20 Decembre ,
+!Config         par expl. ,comme ici ) ... A completer
+  dayref=181
+  CALL getin('dayref', dayref)
+
+!Config  Key  = anneeref
+!Config  Desc = Annee de l'etat initial
+!Config  Def  = 1998
+!Config  Help = Annee de l'etat  initial 
+!Config         (   avec  4  chiffres   ) ... A completer
+  anneeref = 1998
+  CALL getin('anneeref',anneeref)
+
+!Config  Key  = nday
+!Config  Desc = Nombre de jours d'integration
+!Config  Def  = 10
+!Config  Help = Nombre de jours d'integration
+!Config         ... On pourait aussi permettre des mois ou des annees !
+  nday = 10
+  CALL getin('nday',nday)
+
+!Config  Key  = day_step
+!Config  Desc = nombre de pas par jour
+!Config  Def  = 240 
+!Config  Help = nombre de pas par jour (multiple de iperiod) (
+!Config          ici pour  dt = 1 min ) 
+  day_step = 240 
+  CALL getin('day_step',day_step)
+
+!Config  Key  = iperiod
+!Config  Desc = periode pour le pas Matsuno 
+!Config  Def  = 5
+!Config  Help = periode pour le pas Matsuno (en pas de temps) 
+  iperiod = 5
+  CALL getin('iperiod',iperiod)
+
+
+!Config  Key  = iconser
+!Config  Desc = periode de sortie des variables de controle
+!Config  Def  = 240  
+!Config  Help = periode de sortie des variables de controle
+!Config         (En pas de temps)
+  iconser = 240  
+  CALL getin('iconser', iconser)
+
+!Config  Key  = iecri
+!Config  Desc = periode d'ecriture du fichier histoire
+!Config  Def  = 1
+!Config  Help = periode d'ecriture du fichier histoire (en jour) 
+  iecri = 1
+  CALL getin('iecri',iecri)
+
+
+!Config  Key  = periodav
+!Config  Desc = periode de stockage fichier histmoy
+!Config  Def  = 1
+!Config  Help = periode de stockage fichier histmoy (en jour) 
+  periodav = 1.
+  CALL getin('periodav',periodav)
+
+!Config  Key  = idissip
+!Config  Desc = periode de la dissipation 
+!Config  Def  = 10
+!Config  Help = periode de la dissipation 
+!Config         (en pas) ... a completer !
+  idissip = 10
+  CALL getin('idissip',idissip)
+
+!Config  Key  = lstardis
+!Config  Desc = choix de l'operateur de dissipation
+!Config  Def  = y
+!Config  Help = choix de l'operateur de dissipation
+!Config         'y' si on veut star et 'n' si on veut non-start !
+!Config         Moi y en a pas comprendre ! 
+  lstardis = .TRUE.
+  CALL getin('lstardis',lstardis)
+
+
+!Config  Key  = nitergdiv
+!Config  Desc = Nombre d'iteration de gradiv
+!Config  Def  = 1
+!Config  Help = nombre d'iterations de l'operateur de dissipation 
+!Config         gradiv
+  nitergdiv = 1
+  CALL getin('nitergdiv',nitergdiv)
+
+!Config  Key  = nitergrot
+!Config  Desc = nombre d'iterations de nxgradrot
+!Config  Def  = 2
+!Config  Help = nombre d'iterations de l'operateur de dissipation  
+!Config         nxgradrot
+  nitergrot = 2
+  CALL getin('nitergrot',nitergrot)
+
+
+!Config  Key  = niterh
+!Config  Desc = nombre d'iterations de divgrad
+!Config  Def  = 2
+!Config  Help = nombre d'iterations de l'operateur de dissipation
+!Config         divgrad
+  niterh = 2
+  CALL getin('niterh',niterh)
+
+
+!Config  Key  = tetagdiv
+!Config  Desc = temps de dissipation pour div
+!Config  Def  = 7200
+!Config  Help = temps de dissipation des plus petites longeur 
+!Config         d'ondes pour u,v (gradiv)
+  tetagdiv = 7200.
+  CALL getin('tetagdiv',tetagdiv)
+
+!Config  Key  = tetagrot
+!Config  Desc = temps de dissipation pour grad
+!Config  Def  = 7200
+!Config  Help = temps de dissipation des plus petites longeur 
+!Config         d'ondes pour u,v (nxgradrot)
+  tetagrot = 7200.
+  CALL getin('tetagrot',tetagrot)
+
+!Config  Key  = tetatemp 
+!Config  Desc = temps de dissipation pour h
+!Config  Def  = 7200
+!Config  Help =  temps de dissipation des plus petites longeur 
+!Config         d'ondes pour h (divgrad)   
+  tetatemp  = 7200.
+  CALL getin('tetatemp',tetatemp )
+
+!Config  Key  = coefdis
+!Config  Desc = coefficient pour gamdissip
+!Config  Def  = 0
+!Config  Help = coefficient pour gamdissip  
+  coefdis = 0.
+  CALL getin('coefdis',coefdis)
+
+!Config  Key  = purmats
+!Config  Desc = Schema d'integration
+!Config  Def  = n
+!Config  Help = Choix du schema d'integration temporel.
+!Config         y = pure Matsuno sinon c'est du Matsuno-leapfrog
+  purmats = .FALSE.
+  CALL getin('purmats',purmats)
+
+!Config  Key  = physic
+!Config  Desc = Avec ls physique 
+!Config  Def  = y
+!Config  Help = Permet de faire tourner le modele sans 
+!Config         physique.
+  physic = .TRUE.
+  CALL getin('physic',physic)
+
+
+!Config  Key  =  iphysiq
+!Config  Desc = Periode de la physique
+!Config  Def  = 5
+!Config  Help = Periode de la physique en pas de temps de la dynamique.
+  iphysiq = 5
+  CALL getin('iphysiq', iphysiq)
+
+!Config  Key  = ecritphy
+!Config  Desc = Frequence d'ecriture de la physique
+!Config  Def  = 1
+!Config  Help = frequence  de l'ecriture du fichier histphy
+!Config         en jours.
+  ecritphy = 1
+  CALL getin('ecritphy',ecritphy)
+
+!Config  Key  = cycle_diurne
+!Config  Desc = Cycle ddiurne
+!Config  Def  = y
+!Config  Help = Cette option permet d'eteidre le cycle diurne.
+!Config         Peut etre util pour accelerer le code !
+  cycle_diurne = .TRUE.
+  CALL getin('cycle_diurne',cycle_diurne)
+
+!Config  Key  = soil_model
+!Config  Desc = Modele de sol
+!Config  Def  = y
+!Config  Help = Choix du modele de sol (Thermique ?)
+!Config         Option qui pourait un string afin de pouvoir
+!Config         plus de choix ! Ou meme une liste d'options !
+  soil_model = .TRUE.
+  CALL getin('soil_model',soil_model)
+
+!Config  Key  = new_oliq
+!Config  Desc = Nouvelle eau liquide
+!Config  Def  = y
+!Config  Help = Permet de mettre en route la
+!Config         nouvelle parametrisation de l'eau liquide !
+  new_oliq = .TRUE.
+  CALL getin('new_oliq',new_oliq)
+
+!Config  Key  = ok_orodr
+!Config  Desc = Orodr ???
+!Config  Def  = y
+!Config  Help = Y en a pas comprendre !
+!Config         
+  ok_orodr = .TRUE.
+  CALL getin('ok_orodr',ok_orodr)
+
+!Config  Key  =  ok_orolf
+!Config  Desc = Orolf ??
+!Config  Def  = y
+!Config  Help = Connais pas !
+  ok_orolf = .TRUE.
+  CALL getin('ok_orolf', ok_orolf)
+
+!Config  Key  = ok_limitvrai
+!Config  Desc = Force la lecture de la bonne annee
+!Config  Def  = n
+!Config  Help = On peut forcer le modele a lire le
+!Config         fichier SST de la bonne annee. C'est une tres bonne
+!Config         idee, pourquoi ne pas mettre toujours a y ???
+  ok_limitvrai = .FALSE.
+  CALL getin('ok_limitvrai',ok_limitvrai)
+
+!Config  Key  = nbapp_rad
+!Config  Desc = Frequence d'appel au rayonnement
+!Config  Def  = 12
+!Config  Help = Nombre  d'appels des routines de rayonnements
+!Config         par jour.
+  nbapp_rad = 12
+  CALL getin('nbapp_rad',nbapp_rad)
+
+!Config  Key  = iflag_con
+!Config  Desc = Flag de convection
+!Config  Def  = 2
+!Config  Help = Flag  pour la convection les options suivantes existent :
+!Config         1 pour LMD,
+!Config         2 pour Tiedtke,
+!Config         3 pour CCM(NCAR)  
+  iflag_con = 2
+  CALL getin('iflag_con',iflag_con)
+
+!Config  Key  = clon
+!Config  Desc = centre du zoom, longitude
+!Config  Def  = 0
+!Config  Help = longitude en degres du centre 
+!Config         du zoom
+  clonn = 0.
+  CALL getin('clon',clonn)
+
+!Config  Key  = clat
+!Config  Desc = centre du zoom, latitude
+!Config  Def  = 0
+!Config  Help = latitude en degres du centre du zoom
+!Config         
+  clatt = 0.
+  CALL getin('clat',clatt)
+
+!Config  Key  = grossismx 
+!Config  Desc = zoom en longitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la longitude
+  grossismxx = 1.0
+  CALL getin('grossismx',grossismxx)
+
+!Config  Key  = grossismy
+!Config  Desc = zoom en latitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la latitude
+  grossismyy = 1.0
+  CALL getin('grossismy',grossismyy)
+
+!Config  Key  = fxyhypb
+!Config  Desc = Fonction  hyperbolique
+!Config  Def  = y
+!Config  Help = Fonction  f(y)  hyperbolique  si = .true.  
+!Config         sinon  sinusoidale
+  fxyhypbb = .TRUE.
+  CALL getin('fxyhypb',fxyhypbb)
+
+!Config  Key  = dzoomx
+!Config  Desc = extension en longitude
+!Config  Def  = 0
+!Config  Help = extension en longitude  de la zone du zoom  
+!Config         ( fraction de la zone totale)
+  dzoomxx = 0.0
+  CALL getin('dzoomx',dzoomxx)
+
+!Config  Key  = dzoomy
+!Config  Desc = extension en latitude
+!Config  Def  = 0
+!Config  Help = extension en latitude de la zone  du zoom  
+!Config         ( fraction de la zone totale)
+  dzoomyy = 0.0
+  CALL getin('dzoomy',dzoomyy)
+      
+!Config  Key  = taux
+!Config  Desc = raideur du zoom en  X
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  X
+  tauxx = 3.0
+  CALL getin('taux',tauxx)
+
+!Config  Key  = tauyy
+!Config  Desc = raideur du zoom en  Y
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  Y
+  tauyy = 3.0
+  CALL getin('tauy',tauyy)
+
+!Config  Key  = ysinus
+!Config  IF   = !fxyhypb
+!Config  Desc = Fonction en Sinus
+!Config  Def  = y
+!Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true. 
+!Config         sinon y = latit.
+  ysinuss = .TRUE.
+  CALL getin('ysinus',ysinuss)
+
+!Config  Key  = clon
+!Config  Desc = centre du zoom, longitude
+!Config  Def  = 0
+!Config  Help = longitude en degres du centre 
+!Config         du zoom
+  clon = 0.
+  CALL getin('clon',clon)
+
+!Config  Key  = clat
+!Config  Desc = centre du zoom, latitude
+!Config  Def  = 0
+!Config  Help = latitude en degres du centre du zoom
+!Config         
+  clat = 0.
+  CALL getin('clat',clat)
+
+!Config  Key  = grossismx 
+!Config  Desc = zoom en longitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la longitude
+  grossismx = 1.0
+  CALL getin('grossismx',grossismx)
+
+!Config  Key  = grossismy
+!Config  Desc = zoom en latitude
+!Config  Def  = 1.0
+!Config  Help = facteur de grossissement du zoom,
+!Config         selon la latitude
+  grossismy = 1.0
+  CALL getin('grossismy',grossismy)
+
+!Config  Key  = fxyhypb
+!Config  Desc = Fonction  hyperbolique
+!Config  Def  = y
+!Config  Help = Fonction  f(y)  hyperbolique  si = .true.  
+!Config         sinon  sinusoidale
+  fxyhypb = .TRUE.
+  CALL getin('fxyhypb',fxyhypb)
+
+!Config  Key  = dzoomx
+!Config  Desc = extension en longitude
+!Config  Def  = 0
+!Config  Help = extension en longitude  de la zone du zoom  
+!Config         ( fraction de la zone totale)
+  dzoomx = 0.0
+  CALL getin('dzoomx',dzoomx)
+
+!Config  Key  = dzoomy
+!Config  Desc = extension en latitude
+!Config  Def  = 0
+!Config  Help = extension en latitude de la zone  du zoom  
+!Config         ( fraction de la zone totale)
+  dzoomy = 0.0
+  CALL getin('dzoomy',dzoomy)
+
+!Config  Key  = taux
+!Config  Desc = raideur du zoom en  X
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  X
+  taux = 3.0
+  CALL getin('taux',taux)
+
+!Config  Key  = tauy
+!Config  Desc = raideur du zoom en  Y
+!Config  Def  = 3
+!Config  Help = raideur du zoom en  Y
+  tauy = 3.0
+  CALL getin('tauy',tauy)
+
+!Config  Key  = ysinus
+!Config  IF   = !fxyhypb
+!Config  Desc = Fonction en Sinus
+!Config  Def  = y
+!Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true. 
+!Config         sinon y = latit.
+  ysinus = .TRUE.
+  CALL getin('ysinus',ysinus)
+
+!!
+!!
+  CALL DATE_AND_TIME(big_ben(1), big_ben(2), big_ben(3), date_time)
+  date_end = date_time(8) + 1000*date_time(7) + 60*1000*date_time(7)
+  WRITE(*,*) 'Time before dump in milli-sec :', date_end - date_start
+!!
+  CALL getin_dump()
+
+!!
+  CALL DATE_AND_TIME(big_ben(1), big_ben(2), big_ben(3), date_time)
+  date_end = date_time(8) + 1000*date_time(7) + 60*1000*date_time(7)
+  WRITE(*,*) 'Total time in milli-sec :', date_end - date_start
+
+END PROGRAM testconfig2
Index: IOIPSL/tags/v2_1_9/example/testflio.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testflio.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testflio.f90	(revision 715)
@@ -0,0 +1,341 @@
+PROGRAM testflio
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This program is an example of how to use "fliocom".
+!---------------------------------------------------------------------
+  USE ioipsl
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+  INTEGER,PARAMETER :: iimf=3, jjmf=2, llmf=3, itmf=5
+!-
+  REAL,DIMENSION(iimf,jjmf,llmf,itmf) :: forcing
+  REAL,DIMENSION(iimf,jjmf)           :: lonf,latf
+  REAL,DIMENSION(llmf)                :: levf
+  INTEGER,DIMENSION(itmf)             :: itauf
+  REAL :: parf=7.
+!-
+! REAL,DIMENSION(iimf,jjmf,llmf,itmf) :: forcingw
+  REAL,DIMENSION(iimf)                :: lonw
+  REAL,DIMENSION(jjmf)                :: latw
+  REAL,DIMENSION(llmf)                :: levw
+  INTEGER,DIMENSION(itmf)             :: itauw
+! REAL :: parw
+!-
+  CHARACTER(LEN=10),DIMENSION(flio_max_dims) :: f_n_d
+  INTEGER,DIMENSION(flio_max_dims) :: f_l_d,f_i_d
+  INTEGER :: i_t_w,n_d_w,n_a_w
+  INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w,i_d_w
+  LOGICAL :: exv,exa
+  INTEGER :: iim,jjm,llm,ttm
+  INTEGER :: i,j,l,it,fid,id_dom
+  CHARACTER(LEN=25) :: f_n,v_n,c_n,c_tmp=' '
+  INTEGER :: year,month,day
+  REAL :: date,datew,dt,dtw,sec
+  REAL,DIMENSION(10) :: r_w
+  CHARACTER(LEN=30),DIMENSION(:),ALLOCATABLE :: cn_d,cn_v,cn_a
+  CHARACTER(LEN=30) :: cn_u,f_n_c
+!---------------------------------------------------------------------
+!-
+! Create a file for the lateral forcing
+!-
+  DO i=1,iimf
+    DO j=1,jjmf
+      lonf(i,j) = (REAL(i-1)/REAL(MAX(iimf-1,1)))*180.
+      latf(i,j) = (REAL(j-1)/REAL(MAX(jjmf-1,1)))*90.
+    ENDDO
+  ENDDO
+!-
+  levf(1:3) = (/ 0.7, 0.5, 0.3 /)
+!-
+  DO it = 1,itmf
+    itauf(it) = it+10
+    DO i=1,iimf
+      DO j=1,jjmf
+        DO l=1,llmf
+          forcing(i,j,l,it) = 10.*(10.*((10.*it)+l)+j)+i
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  WRITE (*,'(" -----------------------------")')
+  WRITE (*,'(" ------- Using fliocom -------")')
+  WRITE (*,'(" -----------------------------")')
+  WRITE(*,'(/," ",A,3(1X,I5))') &
+ &  'flio_max_files,flio_max_dims,flio_max_var_dims : ', &
+ &   flio_max_files,flio_max_dims,flio_max_var_dims
+!-
+  year = 1997; month = 5; day = 10; sec = 0.;
+  CALL ymds2ju (year,month,day,sec,date)
+  dt = 86400./2.
+  WRITE (*,'(/," ----------------------------------")')
+  WRITE (*,'(/," t_init : ",F11.3)') date
+!-
+! Create a file and add variables and attributes
+!-
+  WRITE (*,'(/," ----------------------------------")')
+!-
+  f_n = 'testflio.nc'
+  f_l_d(1:5) = (/  iimf,  jjmf,  llmf,    -1,   10   /)
+  f_n_d(1:5) = (/ "lon ","lat ","lev ","time","ud1 " /)
+!-
+  CALL flio_dom_set &
+ & (1,1,(/1,2/),(/iimf,jjmf/),(/iimf,jjmf/), &
+ &  (/1,1/),(/iimf,jjmf/),(/0,0/),(/0,0/),"orange",id_dom)
+  WRITE (*,'(/," --> fliocrfd (",A,",...)")') TRIM(f_n)
+  CALL fliocrfd (TRIM(f_n),f_n_d(1:5),f_l_d(1:5),fid, &
+ &               id_dom=id_dom,c_f_n=f_n_c)
+  WRITE (*,'(/,"   created file name : ",A)') TRIM(f_n_c)
+  CALL flio_dom_unset (id_dom)
+!-
+  WRITE (*,'(/," --> fliopstc")')
+  CALL fliopstc (fid, &
+ &  x_axis_2d=lonf(:,:),y_axis_2d=latf(:,:),z_axis=levf(:), &
+ &  t_axis=itauf(:),t_init=date,t_step=dt,t_calendar="gregorian")
+!-
+  CALL fliodefv (fid,'forcing',(/ 1,2,3,4 /), &
+ &               v_t=flio_r4,units='1',long_name='Forcing field')
+  CALL flioputa (fid,'forcing','vecteur_3',(/3.,5.,7./))
+  CALL flioputa (fid,'forcing','text_n',"Text attribute")
+  CALL fliodefv (fid,'my_var_1',(/ 5 /), &
+ &               v_t=flio_r4,units='1',long_name='my_var_1', &
+ &               valid_min=-10.,valid_max=+20.)
+  CALL fliodefv (fid,'Var_vr4', &
+ &               v_t=flio_r4,units='1',long_name='Var_vr4')
+  CALL flioputa (fid,'Var_vr4','att_1',735)
+  CALL flioputa (fid,'?','Param_a4',REAL(parf,KIND=4))
+  CALL fliodefv (fid,'Var_vr8', &
+ &               v_t=flio_r8,units='1',long_name='Var_vr8')
+  CALL fliocpya (fid,'Var_vr4','att_1',fid,'Var_vr8')
+  CALL flioputa (fid,'?','Param_a8',REAL(parf,KIND=8))
+  CALL fliodefv (fid,'Var_vi2', &
+ &               v_t=flio_i2,units='1',long_name='Var_vi2')
+  CALL flioputv (fid,'forcing',forcing)
+  CALL flioputv (fid,'my_var_1',(/3.,4.,5./),start=(/3/))
+  CALL flioputv (fid,'Var_vr4',parf)
+  CALL flioputv (fid,'Var_vr8',parf)
+  CALL flioputv (fid,'Var_vi2',INT(parf,KIND=i_2))
+!-
+  WRITE (*,'(/," --> flioclo")')
+  CALL flioclo (fid)
+!-
+! Inspect the file
+!-
+  WRITE (*,'(/," ----------------------------------")')
+!-
+  WRITE (*,'(/," --> fliodmpf")')
+  CALL fliodmpf (TRIM(f_n_c))
+!-
+! Open the file and obtain information about the file
+!-
+  WRITE (*,'(/," ----------------------------------")')
+!-
+  WRITE (*,'(/," --> flioopfd")')
+  i = 0; j = 0; l = 0;
+  CALL flioopfd (TRIM(f_n_c),fid,nb_dim=i,nb_var=j,nb_gat=l)
+  WRITE (*,'(" Number of dimensions        in the file : ",I2)') i
+  WRITE (*,'(" Number of variables         in the file : ",I2)') j
+  WRITE (*,'(" Number of global attributes in the file : ",I2)') l
+!-
+  WRITE (*,'(/," --> flioinqf")')
+  CALL flioinqf &
+ & (fid,id_dim=f_i_d,ln_dim=f_l_d)
+  IF (i > 0) THEN
+    WRITE (*,'(" Identifiers of the dimensions :",/,(5(1X,I7),:))') &
+ &    f_i_d(1:MIN(i,SIZE(f_i_d)))
+    WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
+ &    f_l_d(1:MIN(i,SIZE(f_l_d)))
+  ENDIF
+!-
+  WRITE (*,'(/," --> flioinqn")')
+  ALLOCATE(cn_d(i),cn_v(j),cn_a(l))
+  CALL flioinqn (fid,cn_dim=cn_d,cn_var=cn_v,cn_gat=cn_a,cn_uld=cn_u)
+  WRITE (*,'(" Names of the dimensions in the file : ")')
+  DO it=1,i
+    WRITE (*,'("   """,A,"""")') TRIM(cn_d(it))
+  ENDDO
+  WRITE (*,'(" Names of the variables in the file : ")')
+  DO it=1,j
+    WRITE (*,'("   """,A,"""")') TRIM(cn_v(it))
+  ENDDO
+  WRITE (*,'(" Names of the global attributes in the file : ")')
+  DO it=1,l
+    WRITE (*,'("   """,A,"""")') TRIM(cn_a(it))
+  ENDDO
+  WRITE (*,'(" Name of the unlimited dimension : ")')
+  WRITE (*,'("   """,A,"""")') TRIM(cn_u)
+  DEALLOCATE(cn_d,cn_v,cn_a)
+!-
+  WRITE (*,'(/," --> flioqstc")')
+  c_n = "x"
+  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
+  IF (exv) THEN
+    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
+ &   TRIM(c_n),TRIM(v_n)
+    CALL flioinqv &
+ &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
+    IF (n_d_w > 0) THEN
+      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
+      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
+ &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
+      iim=l_d_w(1)
+    ENDIF
+    IF (n_a_w > 0) THEN
+      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
+    ENDIF
+  ELSE
+    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
+  ENDIF
+!-
+  WRITE (*,'(/," --> flioqstc")')
+  c_n = "y"
+  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
+  IF (exv) THEN
+    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
+ &   TRIM(c_n),TRIM(v_n)
+    CALL flioinqv &
+ &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
+    IF (n_d_w > 0) THEN
+      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
+      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
+ &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
+      jjm=l_d_w(n_d_w)
+    ENDIF
+    IF (n_a_w > 0) THEN
+      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
+    ENDIF
+  ELSE
+    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
+  ENDIF
+!-
+  WRITE (*,'(/," --> flioqstc")')
+  c_n = "z"
+  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
+  IF (exv) THEN
+    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
+ &   TRIM(c_n),TRIM(v_n)
+    CALL flioinqv &
+ &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
+    IF (n_d_w > 0) THEN
+      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
+      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
+ &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
+      llm=l_d_w(1)
+    ENDIF
+    IF (n_a_w > 0) THEN
+      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
+    ENDIF
+  ELSE
+    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
+  ENDIF
+!-
+  WRITE (*,'(/," --> flioqstc")')
+  c_n = "t"
+  CALL flioqstc (fid,TRIM(c_n),exv,v_n)
+  IF (exv) THEN
+    WRITE (*,'(" Name of the """,A,""" coordinate : ",A)') &
+ &   TRIM(c_n),TRIM(v_n)
+    CALL flioinqv &
+ &   (fid,TRIM(v_n),exv,nb_dims=n_d_w,len_dims=l_d_w,nb_atts=n_a_w) 
+    IF (n_d_w > 0) THEN
+      WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
+      WRITE (*,'(" Dimensions :",/,(5(1X,I7),:))') &
+ &      l_d_w(1:MIN(n_d_w,SIZE(l_d_w)))
+      ttm=l_d_w(1)
+    ENDIF
+    IF (n_a_w > 0) THEN
+      WRITE (*,'(" Number of attributes : ",I2)') n_a_w
+    ENDIF
+  ELSE
+    WRITE (*,'(" Coordinate """,A,""" not found")') TRIM(c_n)
+  ENDIF
+!-
+  WRITE (*,'(/," --> fliogstc")')
+  CALL fliogstc (fid, &
+ &  x_axis=lonw,y_axis=latw,z_axis=levw, &
+ &  t_axis=itauw(:),t_init=datew,t_step=dtw,t_calendar=c_tmp, &
+ &  t_count=3)
+  WRITE (*,'(" x_axis :",/,(5(1X,1PE11.3),:))') lonw(1:iim)
+  WRITE (*,'(" y_axis :",/,(5(1X,1PE11.3),:))') latw(1:jjm)
+  WRITE (*,'(" z_axis :",/,(5(1X,1PE11.3),:))') levw(1:llm)
+  WRITE (*,'(" t_axis(1:3) :",/,(5(1X,I5),:))') itauw(1:3)
+  WRITE (*,'(" t_calendar  : ",A)') '"'//TRIM(c_tmp)//'"'
+  WRITE (*,'(" t_init,t_step :",(2(1X,1PE15.7),:))') datew,dtw
+!-
+  v_n = 'forcing'
+  WRITE (*,'(/," Variable : """,A,"""")') TRIM(v_n)
+  WRITE (*,'(" --> flioinqv(...,""",A,""",...)")') TRIM(v_n)
+  CALL flioinqv &
+ & (fid,TRIM(v_n),exv,v_t=i_t_w, &
+ &  nb_dims=n_d_w,len_dims=l_d_w,id_dims=i_d_w,nb_atts=n_a_w)
+  IF (exv) THEN
+    WRITE (*,'(" External type        : ",I2)') i_t_w
+    WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
+    WRITE (*,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:n_d_w)
+    WRITE (*,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:n_d_w)
+    WRITE (*,'(" Number of attributes : ",I2)') n_a_w
+!---
+    IF (n_a_w > 0) THEN
+      ALLOCATE(cn_a(5))
+      CALL flioinqv (fid,TRIM(v_n),exv,cn_atts=cn_a)
+      WRITE (*,'(" Names of the attributes : ")')
+      DO it=1,n_a_w
+        WRITE (*,'("   """,A,"""")') TRIM(cn_a(it))
+      ENDDO
+      DEALLOCATE(cn_a)
+    ENDIF
+!---
+    WRITE (*, &
+ &   '(" --> flioinqa(...,""",A,""",""text_n"",...)")') TRIM(v_n)
+    CALL flioinqa (fid,TRIM(v_n),"text_n",exa,a_l=l)
+    IF (exa) THEN
+      WRITE (*,'("  len(text_n) : ",I3)') l
+!-----
+      WRITE (*,'(" --> fliogeta(...,""",A,""",""text_n"",...)")') &
+ &     TRIM(v_n)
+      CALL fliogeta (fid,TRIM(v_n),"text_n",c_tmp)
+      WRITE (*,'("  ""text_n"" : """,A,"""")') TRIM(c_tmp)
+    ELSE
+      WRITE (*,'(" Attribute not found")')
+    ENDIF
+  ELSE
+    WRITE (*,'(" Variable not found")')
+  ENDIF
+!-
+  v_n = 'my_var_1'
+  WRITE (*,'(/," Variable : """,A,"""")') TRIM(v_n)
+  WRITE (*,'(" --> flioinqv(...,""",A,""",...)")') TRIM(v_n)
+  CALL flioinqv &
+ & (fid,TRIM(v_n),exv, &
+ &  nb_dims=n_d_w,len_dims=l_d_w,id_dims=i_d_w,nb_atts=n_a_w)
+  IF (exv) THEN
+    WRITE (*,'(" Number of dimensions : ",I2)') n_d_w
+    WRITE (*,'(" Dimensions :",/,5(1X,I7,:))') l_d_w(1:n_d_w)
+    WRITE (*,'(" Identifiers :",/,5(1X,I7,:))') i_d_w(1:n_d_w)
+    WRITE (*,'(" Number of attributes : ",I2)') n_a_w
+    WRITE (*,'(" --> fliogetv(...,""",A,""",...)")') TRIM(v_n)
+    CALL fliogetv (fid,TRIM(v_n),r_w)
+    WRITE (*, &
+ &   '("  Values :",/,(5(1X,1PE11.3),:))') r_w
+    i = 2; j = 5;
+    WRITE (*,'(" --> fliogetv(...,",A, &
+ &             ",start=(/",I2,"/),count=(/",I2,"/))")') &
+ &   '"'//TRIM(v_n)//'"',i,j
+    CALL fliogetv (fid,TRIM(v_n),r_w,start=(/i/),count=(/j/))
+    WRITE (*, &
+ &   '("  Values(",I2,":",I2,") :",/,(5(1X,1PE11.3),:))') &
+ &   i,i+j-1,r_w(1:j)
+  ENDIF
+!-
+  WRITE (*,'(/," --> flioclo")')
+  CALL flioclo (fid)
+!-
+  WRITE (*,'(/," ----------------------------------")')
+!-------------------
+END PROGRAM testflio
Index: IOIPSL/tags/v2_1_9/example/testhist1.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testhist1.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testhist1.f90	(revision 715)
@@ -0,0 +1,134 @@
+PROGRAM testhist1
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This program provide a an example of the basic usage of HIST.
+!- No secial features are used but just the basics.
+!---------------------------------------------------------------------
+  USE ioipsl
+!
+  IMPLICIT NONE
+!
+  INTEGER,PARAMETER :: iim=96, jjm=96, llm=12, nbreg=200
+!
+  REAL :: champ1(iim,jjm), champ2(iim,jjm,llm), champ3(iim,jjm)
+  REAL :: lon(iim,jjm),lat(iim,jjm), lev(llm)
+  REAL :: lon_test(iim),lat_test(jjm)
+  REAL :: x
+!
+  INTEGER :: i, j, l, id, it, ij, sig_id, hori_id
+  INTEGER :: day=15, month=2, year=1997
+  INTEGER :: itau=0, index(nbreg), start
+!
+  REAL :: julday
+  REAL :: deltat=60., dt_wrt, dt_op
+  CHARACTER(LEN=20) :: histname
+!
+  REAL :: pi=3.1415
+!---------------------------------------------------------------------
+!-
+! 1.0 Define a few variables we will need. These are the coordinates
+!     the file name and the date.
+!-
+  DO i=1,iim
+    DO j=1,jjm
+      lon(i,j) = ((float(iim/2)+0.5)-float(i))*pi/float(iim/2) &
+ &              *(-1.)*180./pi
+      lat(i,j) = 180./pi*ASIN(((float(jjm/2)+0.5)-float(j)) &
+ &              /float(jjm/2))
+    ENDDO
+  ENDDO
+!-
+  lon_test(:) = lon(:,1)
+  lat_test(:) = lat(1,:)
+!-
+  DO l=1,llm
+    lev(l) = REAL(l)/llm
+  ENDDO
+!
+  histname = 'testhist1.nc'
+!-
+! 1.1 The chosen date is 15 Feb. 1997 as stated above.
+!     It has to be transformed into julian days using
+!     the calendar provided by IOIPSL.
+!-
+  CALL ymds2ju(year, month, day, 0.,julday)
+  dt_wrt = 3*deltat
+  dt_op = 3*deltat
+!-
+! 2.0 Do all the declarations for hist. That is define the file,
+!     the vertical coordinate and the variables in the file.
+!-
+  CALL ioconf_modname('testhist1 produced this file')
+!-
+  CALL histbeg (histname,iim,lon_test,jjm,lat_test, &
+ &              1,iim,1,jjm,itau,julday,deltat,hori_id,id)
+!-
+  CALL histvert (id,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
+!-
+  CALL histdef (id,"champ1","Some field","m", &
+ &       iim,jjm,hori_id,1,1,1,-99,32,"inst(scatter(x))", &
+ &       dt_op,dt_wrt,var_range=(/1.,-1./))
+!-
+  CALL histdef (id,"champ2","Another field","m", &
+ &       iim,jjm,hori_id,llm,1,llm,sig_id,32,"t_max(max(x,1.0)*2)", &
+ &       deltat,dt_wrt,var_range=(/0.,90./))
+!-
+  CALL histdef (id,"champ3","A field without time","m", &
+ &       iim,jjm,hori_id,1,1,1,-99, 32,"once", &
+ &       deltat,dt_wrt)
+!-
+  CALL histend (id)
+!-
+! 2.1 The filed we are going to write are computes
+!-
+  x = 10.
+  CALL RANDOM_NUMBER(HARVEST=x)
+  CALL RANDOM_NUMBER(champ1)
+  champ3 = champ1
+  DO l=1,llm
+    champ2(:,:,l) = champ1*l
+  ENDDO
+!-
+! 3.0 Start the time steping and write the data as we go along.
+!-
+  start = 1
+!-
+  DO it=1,12
+!---
+!   3.1 In the 2D filed we will have a set of random numbers
+!       which move through the map.
+!---
+    ij = 0
+    DO j=1,nbreg/10
+      DO i=1,10
+        ij = ij+1
+        index(ij) = iim*(j+20)+(i+start)
+      ENDDO
+    ENDDO
+!---
+    IF (start < iim-10) THEN
+      start = start+10
+    ELSE
+      start = 1
+    ENDIF
+!---
+    itau = itau + 1
+!---
+!   3.2 Pass the data to HIST for operation and writing.
+!---
+    CALL histwrite (id,"champ1",itau,champ1,nbreg,index)
+    CALL histwrite (id,"champ2",itau,champ2,iim*jjm*llm,index)
+    CALL histwrite (id,"champ3",itau,champ3,iim*jjm,index)
+    champ1 = champ1+1
+    champ2 = champ2+2
+  ENDDO
+!-
+! 4.0 The HIST routines are ended and netCDF is closed
+!-
+  CALL histclo ()
+!--------------------
+END PROGRAM testhist1
Index: IOIPSL/tags/v2_1_9/example/testhist2.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testhist2.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testhist2.f90	(revision 715)
@@ -0,0 +1,135 @@
+PROGRAM testhist2
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This program provide a an example of the basic usage of HIST.
+!- Here the test the time sampling and averaging. Thus a long
+!- time-series is produced and sampled in different ways.
+!---------------------------------------------------------------------
+  USE ioipsl
+!
+  IMPLICIT NONE
+!
+  INTEGER,PARAMETER :: iim=12,jjm=10,llm=2
+!
+  REAL :: champ1(iim,jjm), champ(iim,jjm), champ2(iim,jjm)
+  REAL :: lon(iim,jjm),lat(iim,jjm), lev(llm)
+  REAL :: x
+!
+  INTEGER :: i, j, l, id, id2, sig_id, hori_id, it
+  INTEGER :: day=1, month=1, year=1997
+  INTEGER :: itau=0, start, index(1)
+!
+  REAL :: julday, un_mois, un_an
+  REAL :: deltat=86400, dt_wrt, dt_op, dt_wrt2, dt_op2
+  CHARACTER(LEN=20) :: histname
+!
+  REAL :: pi=3.1415
+!---------------------------------------------------------------------
+!-
+! 0.0 Choose a 360 days calendar
+!-
+  CALL ioconf_calendar('gregorian')
+!-
+! 1.0 Define a few variables we will need.
+!     These are the coordinates the file name and the date.
+!-
+  DO i=1,iim
+    DO j=1,jjm
+      lon(i,j) = ((float(iim/2)+0.5)-float(i))*pi/float(iim/2) &
+ &              *(-1.)*180./pi
+      lat(i,j) = 180./pi * ASIN(((float(jjm/2)+0.5)-float(j)) &
+ &              /float(jjm/2))
+    ENDDO
+  ENDDO
+!-
+  DO l=1,llm
+    lev(l) = float(l)/llm
+  ENDDO
+!-
+  histname = 'testhist2.nc'
+!-
+! 1.1 The chosen date is 15 Feb. 1997 as stated above.
+!     It has to be transformed into julian days using
+!     the calendar provided by IOIPSL.
+!-
+  CALL ymds2ju(year, month, day, 0.,julday)
+  CALL ioget_calendar(un_an)
+  un_mois = un_an/12.
+  dt_wrt = un_mois*deltat
+  dt_op = deltat
+  dt_wrt2 = -1.
+  dt_op2 = deltat
+!-
+! 2.0 Do all the declarations for hist. That is define the file,
+!     the vertical coordinate and the variables in the file.
+!     Monthly means are written to test this feature
+!-
+  CALL ioconf_modname ('testhist2 produced this file')
+!-
+  CALL histbeg (histname,iim,lon,jjm,lat, &
+ &       1,iim,1,jjm,itau,julday,deltat,hori_id,id)
+!-
+  CALL histvert (id,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
+!-
+  CALL histdef (id,"champ1","Some field","m", &
+ &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt)
+!-
+  CALL histdef (id,"champ2","summed field","m", &
+ &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt)
+!-
+  CALL histend (id)
+!-
+! Open a second file which will do monthly means using the -1 notation.
+!-
+  histname = 'testhist2_bis.nc'
+  CALL histbeg (histname,iim,lon,jjm,lat, &
+ &       1,iim,1,jjm,itau,julday,deltat,hori_id,id2)
+!-
+  CALL histvert (id2,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
+!-
+  CALL histdef (id2,"champ1","Some field","m", &
+ &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2)
+!-
+  CALL histdef (id2,"champ2","summed field","m", &
+ &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2)
+!-
+  CALL histend (id2)
+!-
+! 2.1 The filed we are going to write are computes
+!-
+  CALL RANDOM_NUMBER(HARVEST=x)
+  CALL RANDOM_NUMBER(champ)
+  champ = champ*2*pi
+  champ1 = sin(champ)
+  champ2(:,:) = 1.
+!-
+! 3.0 Start the time steping and write the data as we go along.
+!-
+  start = 1
+!-
+  DO it=1,730
+!---
+!   3.1 In the 2D filed we will have a set of random numbers
+!       which move through the map.
+!---
+    itau = itau+1
+!---
+!   3.2 Pass the data to HIST for operation and writing.
+!---
+    CALL histwrite (id, "champ1",itau,champ1,iim*jjm,index)
+    CALL histwrite (id2,"champ1",itau,champ1,iim*jjm,index)
+    CALL histwrite (id, "champ2",itau,champ2,iim*jjm,index)
+    CALL histwrite (id2,"champ2",itau,champ2,iim*jjm,index)
+!---
+    champ1 = sin((it+1)*champ)
+  ENDDO
+!-
+! 4.0 The HIST routines are ended and netCDF is closed
+!-
+  CALL histclo ()
+!--------------------
+END PROGRAM testhist2
Index: IOIPSL/tags/v2_1_9/example/testopp.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testopp.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testopp.f90	(revision 715)
@@ -0,0 +1,47 @@
+PROGRAM testopp
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This program allows to test the syntaxic analyzer.
+!---------------------------------------------------------------------
+   USE mathelp
+!-
+   IMPLICIT NONE
+!-
+   INTEGER,PARAMETER :: nbopp_max=10
+   REAL,PARAMETER :: missing_val=1.e20
+!- Please list here all the operation you wish to test.
+!- Do not forget to change the value of nbtest.
+   INTEGER,PARAMETER :: nbtest=3
+   CHARACTER(LEN=30),DIMENSION(nbtest) :: test_opp = &
+  &  (/ "t_max(gather(x*2))            ", &
+  &     "(inst(sqrt(max(X,0)*2.0)))    ", &
+  &     "(once)                        " /)
+!-
+   CHARACTER(LEN=80) :: opp
+   CHARACTER(LEN=50) :: ex_topps = 'ave, inst, t_min, t_max, once'
+   REAL,DIMENSION(nbopp_max) :: tmp_scal
+   CHARACTER(LEN=7),DIMENSION(nbopp_max) :: tmp_sopp
+   CHARACTER(LEN=7) :: tmp_topp
+   INTEGER :: nbopp,i,io
+!---------------------------------------------------------------------
+   DO io=1,nbtest
+     opp = test_opp(io)
+     WRITE(*,*) '-------------------------'
+     WRITE(*,*) ' '
+     WRITE(*,*) 'String to be analyzed : ',TRIM(opp)
+     CALL buildop (opp,ex_topps,tmp_topp,nbopp_max,missing_val, &
+    &              tmp_sopp,tmp_scal,nbopp)
+!-
+     WRITE(*,*) 'Time operation : ',TRIM(tmp_topp)
+     WRITE(*,*) 'Other operations  :', nbopp
+     DO i=1,nbopp
+       WRITE(*,*) 'i = ',i,' opp : ',tmp_sopp(i), &
+      &           ' scalar : ',tmp_scal(i)
+     ENDDO
+   ENDDO
+!------------------
+END PROGRAM testopp
Index: IOIPSL/tags/v2_1_9/example/testrest.f90
===================================================================
--- IOIPSL/tags/v2_1_9/example/testrest.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/example/testrest.f90	(revision 715)
@@ -0,0 +1,129 @@
+PROGRAM testrest
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This program provide a an example of the basic usage of REST.
+!- Here the test the time sampling and averaging. Thus a long
+!- time-series is produced and sampled in different ways.
+!---------------------------------------------------------------------
+  USE ioipsl
+!
+  IMPLICIT NONE
+!
+  INTEGER :: iim,jjm,llm
+  PARAMETER (iim=12,jjm=10,llm=2)
+!
+  REAL :: champ1(iim,jjm,llm),champ2(iim,jjm,llm+1),champ3(iim,jjm,llm)
+  REAL :: champ4(iim,jjm)
+  REAL :: champ_read(iim,jjm,llm)
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+!
+  INTEGER :: i,j,l,fid
+  INTEGER :: day=1,month=1,year=1997,itau=1
+!
+  REAL :: julday,un_mois,un_an
+  REAL :: deltat=86400,dt_wrt,dt_op,dt_wrt2,dt_op2
+  CHARACTER*20 :: fnamein,fnameout
+!
+  REAL :: pi=3.1415
+!---------------------------------------------------------------------
+!-
+! 0.0 Choose a  gregorian calendar
+!-
+  CALL ioconf_calendar ('gregorian')
+!-
+! 1.0 Define a few variables we will need.
+!     These are the coordinates the file name and the date.
+!-
+  DO i=1,iim
+    DO j=1,jjm
+      lon(i,j) = &
+ &     ((float(iim/2)+0.5)-float(i))*pi/float(iim/2)*(-1.)*180./pi
+      lat(i,j) = &
+ &     (180./pi)*ASIN(((float(jjm/2)+0.5)-float(j))/float(jjm/2))
+    ENDDO
+  ENDDO
+!-
+  DO l=1,llm
+    lev(l) = float(l)/llm
+  ENDDO
+!-
+! 1.1 The chosen date is 15 Feb. 1997 as stated above. It has to be 
+!     transformed into julian days using the calendar provided by 
+!     IOIPSL.
+!-
+  CALL ymds2ju (year,month,day,0.,julday)
+  CALL ioget_calendar (un_an)
+  un_mois = un_an/12.
+  dt_wrt = un_mois*deltat
+  dt_op = deltat
+  dt_wrt2 = -1.
+  dt_op2 = deltat
+!-
+  fnamein = 'NONE'
+  fnameout = 'restfile'
+!-
+! 2.0 Create a restart file from nothing !
+!-
+  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, &
+ &              itau,julday,deltat,fid)
+!-
+  champ1(:,:,:) = ASIN(1.0)
+  champ2(:,:,:) = EXP(ASIN(1.0))
+!-
+  CALL ioconf_setatt ('units','1')
+  CALL ioconf_setatt ('long_name','Tests 1 for a real variable')
+  CALL restput (fid,'test1',iim,jjm,llm,itau,champ1)
+!-
+  CALL ioconf_setatt ('units','1')
+  CALL ioconf_setatt ('long_name','Tests 2 for a real variable')
+  CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2)
+!-
+  CALL restclo ()
+!-
+  WRITE(*,*) '============== FIRST FILE CLOSED =============='
+!-
+!  3.0 Reopen the restart file and check that the values read are correct
+!-
+  fnamein = 'restfile'
+  fnameout = 'restfilebis'
+!-
+  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, &
+ &              itau,julday,deltat,fid)
+!-
+  CALL restget (fid,'test1',iim,jjm,llm,itau,.FALSE.,champ_read)
+!-
+  itau = itau+10
+  CALL restput (fid,'test1',iim,jjm,llm,itau,champ_read)
+  CALL restput (fid,'test2',iim,jjm,llm+1,itau,champ2)
+!-
+  itau = itau+10
+  champ3(:,:,:) = champ_read(:,:,:)+champ2(:,:,1:llm) 
+  CALL restput (fid,'test1',iim,jjm,llm,itau,champ3)
+!-
+  CALL restclo ()
+!-
+  WRITE(*,'(a25,e36.30)') 'The input data : ',champ1(1,1,1)
+  WRITE(*,'(a25,e36.30)') 'The restart data : ',champ_read(1,1,1)
+!-
+!  4.0 Reopen the restart file and add another time step
+!-
+  fnamein = 'restfilebis'
+  fnameout = 'restfilebis'
+!-
+  CALL restini (fnamein,iim,jjm,lon,lat,llm,lev,fnameout, &
+ &              itau,julday,deltat,fid)
+!-
+  itau = itau+10
+  CALL restput (fid,'test1',iim,jjm,llm,itau,champ1)
+  CALL ioconf_setatt ('units','1')
+  CALL ioconf_setatt ('long_name', &
+ &                    'Test a variable with another dimension')
+  CALL restput (fid,'test4',iim,jjm,0,itau,champ4)
+!-
+  CALL restclo ()
+!-------------------
+END PROGRAM testrest
Index: IOIPSL/tags/v2_1_9/src/AA_make
===================================================================
--- IOIPSL/tags/v2_1_9/src/AA_make	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/AA_make	(revision 715)
@@ -0,0 +1,113 @@
+#-
+#- $Id$
+#-
+MAKE_NAM = $(MAKE)
+ifneq ($(MAKE_NAM),$(M_K))
+ @$(error You must invoke this Makefile with the $(M_K) command)
+endif
+USER_DIR = $(shell /bin/pwd)
+MAKE_DIR = '??'
+ifneq ($(USER_DIR),$(MAKE_DIR))
+ @$(error You must invoke this Makefile from its directory)
+endif
+#-
+#-Q- sxdkrz F_O = $(F_D) $(F_P) -C vsafe -size_t64 -I $(MODDIR)
+#-Q- eshpux F_O = $(F_D) $(F_P) -C vsafe -I $(MODDIR)
+#---------------------------------------------------------------------
+#- Create "libioipsl"
+#---------------------------------------------------------------------
+
+.PRECIOUS : $(MODEL_LIB)
+SXMODEL_LIB = $(MODEL_LIB)
+ifeq ($(L_X),1)
+SXMODEL_LIB = $(LIBDIR)/libsxioipsl.a
+.PRECIOUS : $(SXMODEL_LIB)
+endif
+
+MODS1 = defprec.f90   \
+        errioipsl.f90 \
+        stringop.f90  \
+        mathelp.f90   \
+        getincom.f90  \
+        calendar.f90  \
+        fliocom.f90   \
+        flincom.f90   \
+        histcom.f90   \
+        restcom.f90   \
+        ioipsl.f90
+OBJSMODS1 = $(MODS1:.f90=.o)
+
+all: $(MODEL_LIB)($(OBJSMODS1))
+	@echo IOIPSL is OK
+
+$(MODEL_LIB)(%.o): %.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) $*.f90
+	$(A_C) $(MODEL_LIB) $*.o
+ifeq ($(L_X),1)
+	$(A_X) $(SXMODEL_LIB) $*.o
+endif
+#-Q- sgi6 	mv $(shell echo $* | tr '[:lower:]' '[:upper:]').mod $(MODDIR)
+ifeq ($(M_M),1)
+	mv $*.mod $(MODDIR)
+endif
+	$(RM) $*.o
+
+clean:
+	$(RM) $(MODEL_LIB)
+ifeq ($(L_X),1)
+	$(RM) $(SXMODEL_LIB)
+endif
+	$(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L i.*.f90
+	$(RM) $(MODDIR)/*.mod $(MODDIR)/*.M *.M
+
+#- Specific dependencies
+
+$(MODEL_LIB)(errioipsl.o):   \
+  $(MODEL_LIB)(defprec.o)
+
+$(MODEL_LIB)(stringop.o):    \
+  $(MODEL_LIB)(defprec.o)
+
+$(MODEL_LIB)(mathelp.o):     \
+  $(MODEL_LIB)(errioipsl.o)  \
+  $(MODEL_LIB)(stringop.o)
+
+$(MODEL_LIB)(getincom.o):    \
+  $(MODEL_LIB)(stringop.o)
+
+$(MODEL_LIB)(calendar.o):    \
+  $(MODEL_LIB)(errioipsl.o)  \
+  $(MODEL_LIB)(stringop.o)
+
+$(MODEL_LIB)(fliocom.o):     \
+  $(MODEL_LIB)(defprec.o)    \
+  $(MODEL_LIB)(errioipsl.o)  \
+  $(MODEL_LIB)(stringop.o)   \
+  $(MODEL_LIB)(calendar.o)
+
+$(MODEL_LIB)(flincom.o):     \
+  $(MODEL_LIB)(errioipsl.o)  \
+  $(MODEL_LIB)(stringop.o)   \
+  $(MODEL_LIB)(calendar.o)
+
+$(MODEL_LIB)(histcom.o):     \
+  $(MODEL_LIB)(errioipsl.o)  \
+  $(MODEL_LIB)(stringop.o)   \
+  $(MODEL_LIB)(mathelp.o)    \
+  $(MODEL_LIB)(calendar.o)   \
+  $(MODEL_LIB)(fliocom.o)
+
+$(MODEL_LIB)(restcom.o):     \
+  $(MODEL_LIB)(errioipsl.o)  \
+  $(MODEL_LIB)(stringop.o)   \
+  $(MODEL_LIB)(mathelp.o)    \
+  $(MODEL_LIB)(calendar.o)   \
+  $(MODEL_LIB)(fliocom.o)
+
+$(MODEL_LIB)(ioipsl.o):      \
+  $(MODEL_LIB)(getincom.o)   \
+  $(MODEL_LIB)(fliocom.o)    \
+  $(MODEL_LIB)(flincom.o)    \
+  $(MODEL_LIB)(histcom.o)    \
+  $(MODEL_LIB)(restcom.o)
+
Index: IOIPSL/tags/v2_1_9/src/AA_make.ldef
===================================================================
--- IOIPSL/tags/v2_1_9/src/AA_make.ldef	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/AA_make.ldef	(revision 715)
@@ -0,0 +1,14 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Local parameters for "libioipsl"
+#---------------------------------------------------------------------
+SHELL = /bin/ksh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+P_P =
+MODEL_LIB = $(LIBDIR)/libioipsl.a
Index: IOIPSL/tags/v2_1_9/src/calendar.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/calendar.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/calendar.f90	(revision 715)
@@ -0,0 +1,1044 @@
+MODULE calendar
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This is the calendar which going to be used to do all
+!- calculations on time. Three types of calendars are possible :
+!-
+!-  - gregorian :
+!-      The normal calendar. The time origin for the
+!-      julian day in this case is 24 Nov -4713
+!-      (other names : 'standard','proleptic_gregorian')
+!-  - noleap :
+!-      A 365 day year without leap years.
+!-      The origin for the julian days is in this case 1 Jan 0
+!-      (other names : '365_day','365d')
+!-  - all_leap :
+!-      A 366 day year with leap years.
+!-      The origin for the julian days is in this case ????
+!-      (other names : '366_day','366d'
+!-  - julian :
+!-      same as gregorian, but with all leap century years
+!-  - xxxd :
+!-      Year of xxx days with month of equal length.
+!-      The origin for the julian days is then also 1 Jan 0
+!-
+!- As one can see it is difficult to go from one calendar to the other.
+!- All operations involving julian days will be wrong.
+!- This calendar will lock as soon as possible
+!- the length of the year and forbid any further modification.
+!-
+!- For the non leap-year calendar the method is still brute force.
+!- We need to find an Integer series which takes care of the length
+!- of the various month. (Jan)
+!-
+!-   one_day  : one day in seconds
+!-   one_year : one year in days
+!---------------------------------------------------------------------
+  USE stringop,ONLY  : strlowercase
+  USE errioipsl,ONLY : ipslerr
+!-
+  PRIVATE
+  PUBLIC :: ymds2ju,ju2ymds,tlen2itau,isittime,ioconf_calendar, &
+ &          ioget_calendar,ioget_mon_len,ioget_year_len,itau2date, &
+ &          ioget_timestamp,ioconf_startdate,itau2ymds, &
+ &          time_diff,time_add,lock_calendar
+!-
+  INTERFACE ioget_calendar
+    MODULE PROCEDURE &
+ &    ioget_calendar_real1,ioget_calendar_real2,ioget_calendar_str
+  END INTERFACE
+!-
+  INTERFACE ioconf_startdate
+     MODULE PROCEDURE &
+ &    ioconf_startdate_simple,ioconf_startdate_internal, &
+ &    ioconf_startdate_ymds
+  END INTERFACE
+!-
+  REAL,PARAMETER :: one_day = 86400.0
+  LOGICAL,SAVE :: lock_startdate = .FALSE.
+!-
+  CHARACTER(LEN=30),SAVE :: time_stamp='XXXXXXXXXXXXXXXX'
+!-
+!- Description of calendar
+!-
+  CHARACTER(LEN=20),SAVE :: calendar_used="gregorian"
+  LOGICAL,SAVE :: lock_one_year = .FALSE.
+  REAL,SAVE :: one_year = 365.2425
+  INTEGER,SAVE :: mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+!-
+  CHARACTER(LEN=3),PARAMETER :: &
+ &  cal(12) = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+ &              'JUL','AUG','SEP','OCT','NOV','DEC'/)
+!-
+  REAL,SAVE :: start_day,start_sec
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE lock_calendar (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "lock_calendar" routine
+!! allows to lock or unlock the calendar,
+!! and to know the current status of the calendar.
+!! Be careful !
+!!
+!! SUBROUTINE lock_calendar (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the calendar
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the calendar
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = lock_one_year
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    lock_one_year = new_status
+  ENDIF
+!---------------------------
+END SUBROUTINE lock_calendar
+!-
+!===
+!-
+SUBROUTINE ymds2ju (year,month,day,sec,julian)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  REAL,INTENT(OUT) :: julian
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!-
+  julian = julian_day+julian_sec/one_day
+!---------------------
+END SUBROUTINE ymds2ju
+!-
+!===
+!-
+SUBROUTINE ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!---------------------------------------------------------------------
+!- Converts year, month, day and seconds into a julian day
+!-
+!- In 1968 in a letter to the editor of Communications of the ACM
+!- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
+!- and Thomas C. Van Flandern presented such an algorithm.
+!-
+!- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
+!-
+!- In the case of the Gregorian calendar we have chosen to use
+!- the Lilian day numbers. This is the day counter which starts
+!- on the 15th October 1582.
+!- This is the day at which Pope Gregory XIII introduced the
+!- Gregorian calendar.
+!- Compared to the true Julian calendar, which starts some
+!- 7980 years ago, the Lilian days are smaler and are dealt with
+!- easily on 32 bit machines. With the true Julian days you can only
+!- the fraction of the day in the real part to a precision of
+!- a 1/4 of a day with 32 bits.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  INTEGER,INTENT(OUT) :: julian_day
+  REAL,INTENT(OUT)    :: julian_sec
+!-
+  INTEGER :: jd,m,y,d,ml
+!---------------------------------------------------------------------
+  lock_one_year = .TRUE.
+!-
+  m = month
+  y = year
+  d = day
+!-
+!- We deduce the calendar from the length of the year as it
+!- is faster than an INDEX on the calendar variable.
+!-
+  IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!-- "Gregorian"
+    jd = (1461*(y+4800+INT((m-14)/12)))/4 &
+ &      +(367*(m-2-12*(INT((m-14)/12))))/12 &
+ &      -(3*((y+4900+INT((m-14)/12))/100))/4 &
+ &      +d-32075
+    jd = jd-2299160
+  ELSE IF (    (ABS(one_year-365.0) <= EPSILON(one_year))  &
+ &         .OR.(ABS(one_year-366.0) <= EPSILON(one_year)) ) THEN
+!-- "No leap" or "All leap"
+    ml = SUM(mon_len(1:m-1))
+    jd = y*NINT(one_year)+ml+(d-1)
+  ELSE
+!-- Calendar with regular month
+    ml = NINT(one_year/12.)
+    jd = y*NINT(one_year)+(m-1)*ml+(d-1)
+  ENDIF
+!-
+  julian_day = jd
+  julian_sec = sec
+!------------------------------
+END SUBROUTINE ymds2ju_internal
+!-
+!===
+!-
+SUBROUTINE ju2ymds (julian,year,month,day,sec)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(IN) :: julian
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  julian_day = INT(julian)
+  julian_sec = (julian-julian_day)*one_day
+!-
+  CALL ju2ymds_internal(julian_day,julian_sec,year,month,day,sec)
+!---------------------
+END SUBROUTINE ju2ymds
+!-
+!===
+!-
+SUBROUTINE ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine computes from the julian day the year,
+!- month, day and seconds
+!-
+!- In 1968 in a letter to the editor of Communications of the ACM
+!- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
+!- and Thomas C. Van Flandern presented such an algorithm.
+!-
+!- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
+!-
+!- In the case of the Gregorian calendar we have chosen to use
+!- the Lilian day numbers. This is the day counter which starts
+!- on the 15th October 1582. This is the day at which Pope
+!- Gregory XIII introduced the Gregorian calendar.
+!- Compared to the true Julian calendar, which starts some 7980
+!- years ago, the Lilian days are smaler and are dealt with easily
+!- on 32 bit machines. With the true Julian days you can only the
+!- fraction of the day in the real part to a precision of a 1/4 of
+!- a day with 32 bits.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: julian_day
+  REAL,INTENT(IN)    :: julian_sec
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: l,n,i,jd,j,d,m,y,ml
+  INTEGER :: add_day
+  REAL :: eps_day
+!---------------------------------------------------------------------
+  eps_day = SPACING(one_day)
+  lock_one_year = .TRUE.
+!-
+  jd = julian_day
+  sec = julian_sec
+  IF (sec > (one_day-eps_day)) THEN
+    add_day = INT(sec/one_day)
+    sec = sec-add_day*one_day
+    jd = jd+add_day
+  ENDIF
+  IF (sec < -eps_day) THEN
+    sec = sec+one_day
+    jd = jd-1
+  ENDIF
+!-
+  IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!-- Gregorian
+    jd = jd+2299160
+!-
+    l = jd+68569
+    n = (4*l)/146097
+    l = l-(146097*n+3)/4
+    i = (4000*(l+1))/1461001
+    l = l-(1461*i)/4+31
+    j = (80*l)/2447
+    d = l-(2447*j)/80
+    l = j/11
+    m = j+2-(12*l)
+    y = 100*(n-49)+i+l
+  ELSE IF (    (ABS(one_year-365.0) <= EPSILON(one_year)) &
+ &         .OR.(ABS(one_year-366.0) <= EPSILON(one_year)) ) THEN
+!-- No leap or All leap
+    y = jd/NINT(one_year)
+    l = jd-y*NINT(one_year)
+    m = 1
+    ml = 0
+    DO WHILE (ml+mon_len(m) <= l)
+      ml = ml+mon_len(m)
+      m = m+1
+    ENDDO
+    d = l-ml+1
+  ELSE
+!-- others
+    ml = NINT(one_year/12.)
+    y = jd/NINT(one_year)
+    l = jd-y*NINT(one_year)
+    m = (l/ml)+1
+    d = l-(m-1)*ml+1
+  ENDIF
+!-
+  day = d
+  month = m
+  year = y
+!------------------------------
+END SUBROUTINE ju2ymds_internal
+!-
+!===
+!-
+SUBROUTINE tlen2itau (input_str,dt,date,itau)
+!---------------------------------------------------------------------
+!- This subroutine transforms a string containing a time length
+!- into a number of time steps.
+!- To do this operation the date (in julian days is needed as the
+!- length of the month varies.
+!- The following convention is used :
+!-   n   : n time steps
+!-   nS  : n seconds is transformed into itaus
+!-   nH  : n hours
+!-   nD  : n days
+!-   nM  : n month
+!-   nY  : n years
+!- Combinations are also possible
+!-   nYmD : nyears plus m days !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: input_str
+  REAL,INTENT(IN)             :: dt,date
+!-
+  INTEGER,INTENT(OUT)         :: itau
+!-
+  INTEGER           :: y_pos,m_pos,d_pos,h_pos,s_pos
+  INTEGER           :: read_time
+  CHARACTER(LEN=13) :: fmt
+  CHARACTER(LEN=80) :: tmp_str
+!-
+  INTEGER :: year,month,day
+  REAL    :: sec,date_new,dd,ss
+!---------------------------------------------------------------------
+  itau = 0
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  y_pos = MAX(INDEX(input_str,'y'),INDEX(input_str,'Y'))
+  m_pos = MAX(INDEX(input_str,'m'),INDEX(input_str,'M'))
+  d_pos = MAX(INDEX(input_str,'d'),INDEX(input_str,'D'))
+  h_pos = MAX(INDEX(input_str,'h'),INDEX(input_str,'H'))
+  s_pos = MAX(INDEX(input_str,'s'),INDEX(input_str,'S'))
+!-
+  IF (MAX(y_pos,m_pos,d_pos,s_pos) > 0) THEN
+    tmp_str = input_str
+    DO WHILE ( MAX(y_pos,m_pos,d_pos,s_pos) > 0)
+!---- WRITE(*,*) tmp_str
+!---- WRITE(*,*) y_pos,m_pos,d_pos,s_pos
+      IF (y_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') y_pos-1
+        READ(tmp_str(1:y_pos-1),fmt) read_time
+        CALL ymds2ju (year+read_time,month,day,sec,date_new)
+        dd = date_new-date
+        ss = INT(dd)*one_day+dd-INT(dd)
+        itau = itau+NINT(ss/dt)
+        tmp_str = tmp_str(y_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (m_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') m_pos-1
+        READ(tmp_str(1:m_pos-1),fmt) read_time
+        CALL ymds2ju (year,month+read_time,day,sec,date_new)
+        dd = date_new-date
+        ss = INT(dd)*one_day+dd-INT(dd)
+        itau = itau+NINT(ss/dt)
+        tmp_str = tmp_str(m_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (d_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') d_pos-1
+        READ(tmp_str(1:d_pos-1),fmt) read_time
+        itau = itau+NINT(read_time*one_day/dt)
+        tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (h_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') h_pos-1
+        READ(tmp_str(1:h_pos-1),fmt) read_time
+        itau = itau+NINT(read_time*60.*60./dt)
+        tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF  (s_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') s_pos-1
+        READ(tmp_str(1:s_pos-1),fmt) read_time
+        itau = itau+NINT(read_time/dt)
+        tmp_str = tmp_str(s_pos+1:LEN_TRIM(tmp_str))
+      ENDIF
+!-
+      y_pos = MAX(INDEX(tmp_str,'y'),INDEX(tmp_str,'Y'))
+      m_pos = MAX(INDEX(tmp_str,'m'),INDEX(tmp_str,'M'))
+      d_pos = MAX(INDEX(tmp_str,'d'),INDEX(tmp_str,'D'))
+      h_pos = MAX(INDEX(tmp_str,'h'),INDEX(tmp_str,'H'))
+      s_pos = MAX(INDEX(tmp_str,'s'),INDEX(tmp_str,'S'))
+    ENDDO
+  ELSE
+    WRITE(fmt,'("(I",I10.10,")")') LEN_TRIM(input_str)
+    READ(input_str(1:LEN_TRIM(input_str)),fmt) itau
+  ENDIF
+!-----------------------
+END SUBROUTINE tlen2itau
+!-
+!===
+!-
+REAL FUNCTION itau2date (itau,date0,deltat)
+!---------------------------------------------------------------------
+!- This function transforms itau into a date. The date with which
+!- the time axis is going to be labeled
+!-
+!- INPUT
+!-   itau   : current time step
+!-   date0  : Date at which itau was equal to 0
+!-   deltat : time step between itau s
+!-
+!- OUTPUT
+!-   itau2date : Date for the given itau
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER  :: itau
+  REAL     :: date0,deltat
+!---------------------------------------------------------------------
+  itau2date = REAL(itau)*deltat/one_day+date0
+!---------------------
+END FUNCTION itau2date
+!-
+!===
+!-
+SUBROUTINE itau2ymds (itau,deltat,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine transforms itau into a date. The date with which
+!- the time axis is going to be labeled
+!-
+!- INPUT
+!-   itau   : current time step
+!-   deltat : time step between itau s
+!-
+!- OUTPUT
+!-   year  : year
+!-   month : month
+!-   day   : day
+!-   sec   : seconds since midnight
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: deltat
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  IF (.NOT.lock_startdate) THEN
+    CALL ipslerr (2,'itau2ymds', &
+ &   'You try to call this function, itau2ymds, but you didn''t', &
+ &   ' call ioconf_startdate to initialize date0 in calendar.', &
+ &   ' Please call ioconf_startdate before itau2ymds.')
+  ENDIF
+  julian_day = start_day
+  julian_sec = start_sec+REAL(itau)*deltat
+  CALL ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
+!-----------------------
+END SUBROUTINE itau2ymds
+!-
+!===
+!-
+REAL FUNCTION dtchdate (itau,date0,old_dt,new_dt)
+!---------------------------------------------------------------------
+!- This function changes the date so that the simulation can
+!- continue with the same itau but a different dt.
+!-
+!- INPUT
+!-   itau   : current time step
+!-   date0  : Date at which itau was equal to 0
+!-   old_dt : Old time step between itaus
+!-   new_dt : New time step between itaus
+!-
+!- OUTPUT
+!-   dtchdate : Date for the given itau
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: date0,old_dt,new_dt
+!-
+  REAL :: rtime
+!---------------------------------------------------------------------
+  rtime = itau2date (itau,date0,old_dt)
+  dtchdate = rtime-REAL(itau)*new_dt/one_day
+!--------------------
+END FUNCTION dtchdate
+!-
+!===
+!-
+SUBROUTINE isittime &
+ &  (itau,date0,dt,freq,last_action,last_check,do_action)
+!---------------------------------------------------------------------
+!- This subroutine checks the time as come for a given action.
+!- This is computed from the current time-step(itau).
+!- Thus we need to have the time delta (dt), the frequency
+!- of the action (freq) and the last time it was done
+!- (last_action in units of itau).
+!- In order to extrapolate when will be the next check we need
+!- the time step of the last call (last_check).
+!-
+!- The test is done on the following condition :
+!- the distance from the current time to the time for the next
+!- action is smaller than the one from the next expected
+!- check to the next action.
+!- When the test is done on the time steps 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: IOIPSL/tags/v2_1_9/src/def.prec
===================================================================
--- IOIPSL/tags/v2_1_9/src/def.prec	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/def.prec	(revision 715)
@@ -0,0 +1,22 @@
+MODULE defprec 
+!-
+! $Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! The module "defprec" set default precision for computation
+!!
+!! This module should be used by every modules
+!! to keep the right precision for every variable
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER,PARAMETER :: i_1=SELECTED_INT_KIND(2)
+  INTEGER,PARAMETER :: i_2=SELECTED_INT_KIND(4)
+  INTEGER,PARAMETER :: i_4=SELECTED_INT_KIND(9)
+  INTEGER,PARAMETER :: i_8=SELECTED_INT_KIND(13)
+  INTEGER,PARAMETER :: r_4=SELECTED_REAL_KIND(6,37)
+  INTEGER,PARAMETER :: r_8=SELECTED_REAL_KIND(15,307)
+  INTEGER,PARAMETER :: i_std=i_?, r_std=r_?
+!-----------------
+END MODULE defprec
Index: IOIPSL/tags/v2_1_9/src/errioipsl.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/errioipsl.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/errioipsl.f90	(revision 715)
@@ -0,0 +1,214 @@
+MODULE errioipsl
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     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: IOIPSL/tags/v2_1_9/src/flincom.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/flincom.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/flincom.f90	(revision 715)
@@ -0,0 +1,1939 @@
+MODULE flincom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar
+  USE errioipsl, ONLY : histerr
+  USE stringop,  ONLY : strlowercase
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: flinput, flincre, flinget, flinclo, &
+            flinopen, flininfo, flininspect, flinquery_var
+!-
+  INTERFACE flinopen
+!---------------------------------------------------------------------
+!- The "flinopen" routines will open an input file
+!-
+!- INPUT
+!-
+!- filename  : Name of the netCDF file to be opened
+!-
+!- iideb     : index i for zoom     !
+!- iilen     : length  of  zoom     !   for
+!- jjdeb     : index j for zoom     !   zoom
+!- jjlen     : length  of  zoom     !
+!-
+!- do_test   : A flag that enables the testing of the content
+!-             of the file against the input from the model
+!-
+!- INPUT if do_test=TRUE      OUTPUT else
+!-
+!- iim       : size in the x direction in the file (longitude)
+!- jjm       : size in the y direction
+!- llm       : number of levels
+!-             (llm = 0 means no axis to be expected)
+!- lon       : array of (iilen,jjlen) (zoom), or (iim,jjm) (no zoom),
+!-             that contains the longitude of each point
+!- lat       : same for latitude
+!- lev       : An array of llm for the latitude
+!-
+!- WARNING :
+!- In the case of do_test=FALSE it is for the user to check
+!- that the dimensions of lon lat and lev are correct when passed to
+!- flinopen. This can be done after the call when iim and jjm have
+!- been retrieved from the netCDF file. In F90 this problem will
+!- be solved with an internal assign
+!- IF iim, jjm, llm or ttm are parameters in the calling program and
+!- you use the option do_test=FALSE it will create a segmentation fault
+!-
+!-  OUTPUT
+!-
+!-  ttm       : size of time axis
+!-  itaus     : Time steps within this file
+!-  date0     : Julian date at which itau = 0
+!-  dt        : length of the time steps of the data
+!-  fid       : returned file ID which is later used to read the data
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinopen_zoom2d, flinopen_nozoom
+  END INTERFACE
+!-
+  INTERFACE flinput
+!---------------------------------------------------------------------
+!- The "flinput" routines will put a variable
+!- on the netCDF file created by flincre.
+!- If the sizes of the axis do not match the one of the IDs
+!- then a new axis is created.
+!- That is we loose the possibility of writting hyperslabs of data.
+!-
+!- Again here if iim = jjm = llm = ttm = 0
+!- then a global attribute is added to the file.
+!-
+!- INPUT
+!-
+!- fid      : Identification of the file in which we will write
+!- varname  : Name of variable to be written
+!- iim      : size in x of variable
+!- nlonid   : ID of x axis which could fit for this axis
+!- jjm      : size in y of variable
+!- nlatid   : ID of y axis which could fit for this axis
+!- llm      : size in z of variable
+!- zdimid   : ID of z axis which could fit for this axis
+!- ttm      : size in t of variable
+!- tdimid   : ID of t axis which could fit for this axis
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, &
+                     flinput_r1d, flinput_scal
+  END INTERFACE
+!-
+  INTERFACE flinget
+    MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, &
+                     flinget_r1d, flinget_scal, &
+                     flinget_r4d_zoom2d, flinget_r3d_zoom2d, &
+                     flinget_r2d_zoom2d
+  END INTERFACE
+!-
+! This is the data we keep on each file we open
+!-
+  INTEGER, PARAMETER :: nbfile_max = 200
+  INTEGER, SAVE :: nbfiles = 0
+  INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), &
+                   ncfunli(nbfile_max), ncnba(nbfile_max)
+  INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4)
+  LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE.
+!-
+  INTEGER, SAVE :: cind_vid, cind_fid, cind_len
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex
+!-
+  INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE flincre &
+  (filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, &
+   time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1)
+!---------------------------------------------------------------------
+!- This is a "low level" subroutine for opening netCDF files wich
+!- contain the major coordinate system of the model.
+!- Other coordinates needed for other variables
+!- will be added as they are needed.
+!-
+!- INPUT
+!-
+!- filename    : Name of the file to be created
+!- iim1, jjm1  : Horizontal size of the grid
+!-               which will be stored in the file
+!- lon1, lat1  : Horizontal grids
+!- llm1        : Size of the vertical grid
+!- lev1        : Vertical grid
+!- ttm1        : Size of time axis
+!- itaus       : time steps on the time axis
+!- time0       : Time in julian days at which itau = 0
+!- dt          : time step in seconds between itaus
+!-               (one step of itau)
+!-
+!- OUTPUT
+!-
+!- fid         : File identification
+!- nlonid1     : Identification of longitudinal axis
+!- nlatid1     : Identification of latitudinal axis
+!- zdimid1     : ID of vertical axis
+!- tdimid1     : ID of time axis
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim1, jjm1, llm1, ttm1
+  REAL :: lon1(iim1,jjm1)
+  REAL :: lat1(iim1,jjm1)
+  REAL :: lev1(llm1)
+  INTEGER :: itaus(ttm1)
+  REAL :: time0
+  REAL :: dt
+  INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1
+!-
+! LOCAL
+!-
+  INTEGER :: iret, lll, fid
+  INTEGER :: lonid, latid, levid, timeid
+  INTEGER :: year, month, day
+  REAL :: sec
+  CHARACTER(LEN=250):: name
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name=filename(1:lll)//'.nc'
+  ELSE
+    name=filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_CREATE (name, NF90_CLOBBER, fid)
+!-
+  iret = NF90_DEF_DIM (fid, 'x',     iim1, nlonid1)
+  iret = NF90_DEF_DIM (fid, 'y',     jjm1, nlatid1)
+  iret = NF90_DEF_DIM (fid, 'lev',   llm1, zdimid1)
+  iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1)
+!-
+! Vertical axis
+!-
+  IF (check) WRITE(*,*) 'flincre Vertical axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)
+  iret = NF90_PUT_ATT (fid, levid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, levid, 'title',     'levels')
+  iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels')
+!-
+! Time axis
+!-
+  IF (check) WRITE(*,*) 'flincre time axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)
+  iret = NF90_PUT_ATT (fid, timeid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, timeid, 'title',     'time')
+  iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps')
+!-
+! The longitude
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &
+                       (/ nlonid1, nlatid1 /), lonid)
+  iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east")
+  iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude")
+  iret = NF90_PUT_ATT (fid, lonid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_min', &
+                       REAL(MINVAL(lon1),KIND=4))
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_max', &
+                       REAL(MAXVAL(lon1),KIND=4))
+!-
+! The Latitude
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &
+                     (/ nlonid1, nlatid1 /), latid)
+  iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north")
+  iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude")
+  iret = NF90_PUT_ATT (fid, latid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, latid, 'valid_min', &
+                       REAL(MINVAL(lat1),KIND=4))
+  iret = NF90_PUT_ATT (fid, latid, 'valid_max', &
+                       REAL(MAXVAL(lat1),KIND=4))
+!-
+! The time coordinates
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', &
+                       REAL(dt,KIND=4))
+!-
+  CALL ju2ymds (time0, year, month, day, sec)
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0',  REAL(year,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0',   REAL(day,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0',   REAL(sec,KIND=4))
+!-
+  iret = NF90_ENDDEF (fid)
+!-
+  IF (check) WRITE(*,*) 'flincre Variable'
+!-
+  iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Time Variable'
+!-
+  iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude'
+!-
+  iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude'
+!-
+  iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flincre', &
+     'Too many files. Please increase nbfil_max', &
+     'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = 4
+!-
+  ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /)
+!-
+  ncfunli(nbfiles) = -1
+  ncnba(nbfiles)   =  4
+  ncnbva(nbfiles)  =  0
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!---------------------
+END SUBROUTINE flincre
+!-
+!===
+!-
+SUBROUTINE flinopen_zoom2d &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+  iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
+                           iideb, iilen, jjdeb, jjlen, iim, jjm
+  IF (check) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
+  IF (check) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
+!-
+  CALL flinopen_work &
+    (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-----------------------------
+END SUBROUTINE flinopen_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinopen_nozoom &
+  (filename, do_test, iim, jjm, llm, lon, lat, lev, ttm, &
+   itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm
+  REAL :: lon(iim,jjm), lat(iim,jjm), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!---------------------------------------------------------------------
+  CALL flinopen_work &
+    (filename, 1, iim, 1, jjm, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-------------------------
+END SUBROUTINE flinopen_nozoom
+!-
+!===
+!-
+SUBROUTINE flinopen_work &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+   iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+! LOCAL
+!-
+  REAL, PARAMETER :: eps = 1.e-4
+!-
+  INTEGER :: iret, vid, fid, nbdim, i, iilast, jjlast
+  INTEGER :: gdtt_id, old_id, iv, gdtmaf_id
+  CHARACTER(LEN=250) :: name
+  CHARACTER(LEN=80) :: units, calendar
+  INTEGER :: tmp_iim, tmp_jjm, tmp_llm, tmp_ttm
+  REAL :: x_first, x_last
+  INTEGER :: year, month, day
+  REAL :: r_year, r_month, r_day
+  INTEGER :: year0, month0, day0, hours0, minutes0, seci
+  REAL :: sec, sec0
+  CHARACTER :: strc
+!-
+  REAL,DIMENSION(:),ALLOCATABLE :: vec_tmp
+!-
+  LOGICAL :: open_file
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  iilast = iideb+iilen-1
+  jjlast = jjdeb+jjlen-1
+  IF (check) WRITE (*,*) &
+    ' flinopen_work zoom 2D information '// &
+    ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', &
+      iideb, iilen, iilast, jjdeb, jjlen, jjlast
+!-
+! 1.0 get all infos on the file
+!-
+! Either the fid_out has not been initialized (0 or very large)
+! then we have to open anyway. Else we only need to open the file
+! if it has not been opened before.
+!-
+  IF ( (fid_out < 1).OR.(fid_out > nbfile_max) ) THEN
+    open_file = .TRUE.
+  ELSE IF (.NOT.ncfileopen(fid_out)) THEN
+    open_file = .TRUE.
+  ELSE
+    open_file = .FALSE.
+  ENDIF
+!-
+  IF (open_file) THEN
+    CALL flininfo (filename,tmp_iim,tmp_jjm,tmp_llm,tmp_ttm,fid_out)
+  ELSE
+!-- The user has already opened the file
+!-- and we trust that he knows the dimensions
+    tmp_iim = iim
+    tmp_jjm = jjm
+    tmp_llm = llm
+    tmp_ttm = ttm
+  ENDIF
+!-
+  IF (check) &
+    WRITE(*,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
+!-
+  fid = ncids(fid_out)
+!-
+! 2.0 get the sizes and names of the different coordinates
+!     and do a first set of verification.
+!-
+! 2.2 We test the axis if we have to.
+!-
+  IF (check) &
+    WRITE(*,*) 'flininfo 2.2 We test if we have to test : ',do_test
+!-
+  IF (do_test) THEN
+    IF      (iim /= tmp_iim) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in x direction (longitude)',' ')
+    ELSE IF (jjm /= tmp_jjm) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in y direction (latitude)',' ')
+    ELSE IF ( llm /= tmp_llm .AND. llm > 0 ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in the vertical',' ')
+    ENDIF
+  ELSE
+!---
+!-- 2.3 Else the sizes of the axes are returned to the user
+!---
+    IF (check) WRITE(*,*) 'flinopen 2.3 Else sizes are returned'
+!---
+    iim = tmp_iim
+    jjm = tmp_jjm
+    llm = tmp_llm
+  ENDIF
+!-
+  ttm = tmp_ttm
+!-
+! 3.0 Check if we are realy talking about the same coodinate system
+!     if not then we get the lon, lat and lev variables from the file
+!-
+  IF (check) WRITE(*,*) 'flinopen 3.0 we are realy talking'
+!-
+  IF (do_test) THEN
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) &
+      WRITE(*,*) 'from file lon first and last, modulo 360. ', &
+        x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.)
+    IF (check) &
+      WRITE(*,*) 'from model lon first and last, modulo 360. ', &
+        lon(1,1),lon(iilen,jjlen), &
+        MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.)
+    IF (    (ABS( MODULO(x_first,360.) &
+                 -MODULO(lon(1,1),360.)) > eps) &
+        .OR.(ABS( MODULO(x_last,360.) &
+                 -MODULO(lon(iilen ,jjlen),360.)) > eps ) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same longitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) WRITE(*,*) &
+      'from file lat first and last ',x_first,x_last
+    IF (check) WRITE(*,*) &
+      'from model lat first and last ',lat(1,1),lat(iilen,jjlen)
+!---
+    IF (    (ABS(x_first-lat(1,1)) > eps) &
+        .OR.(ABS(x_last-lat(iilen,jjlen)) > eps) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same latitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      iret = NF90_GET_VAR (fid, vid, x_first, start=(/ 1 /))
+      iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /))
+!-----
+      IF (check) WRITE(*,*) &
+        'from file lev first and last ',x_first ,x_last
+      IF (check) WRITE(*,*) &
+        'from model lev first and last ',lev(1),lev(llm)
+!-----
+      IF (    (ABS(x_first-lev(1)) > eps) &
+          .OR.(ABS(x_last-lev(llm)) > eps) ) THEN
+        CALL histerr (3,'flinopen', &
+          'file '//filename//' and the model do not', &
+          'share the same vertical coordinate', &
+          'Obtained by comparing the first and last values')
+      ENDIF
+    ENDIF
+!---
+  ELSE
+!---
+!-- 4.0 extracting the coordinates if we do not check
+!---
+    IF (check) WRITE(*,*) 'flinopen 4.0 extracting the coordinates'
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lon, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(iilen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ iideb /), count=(/ iilen /))
+      DO i=1,jjlen
+        lon(:,i) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lat, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(jjlen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ jjdeb /), count=(/ jjlen /))
+      DO i=1,iilen
+        lat(i,:) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      IF (nbdim == 1) THEN
+        iret = NF90_GET_VAR (fid, vid, lev, &
+                 start=(/ 1 /), count=(/ llm /))
+      ELSE
+        CALL histerr (3,'flinopen', &
+          'Can not handle vertical coordinates that have more',&
+          'than 1 dimension',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!-
+! 5.0 Get all the details for the time if possible needed
+!-
+  IF (check) WRITE(*,*) 'flinopen 5.0 Get time'
+!-
+  IF (ttm > 0) THEN
+!---
+!-- 5.1 Find the time axis. Prefered method is the 'timestep since'
+!---
+    gdtmaf_id = -1
+    gdtt_id = -1
+    old_id = -1
+    DO iv=1,ncnbva(fid_out)
+      name=''
+      iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)
+      units=''
+      iret = NF90_GET_ATT (fid, iv, 'units', units)
+      IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv
+      IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv
+      IF (INDEX(name, 'tstep') > 0) old_id = iv
+    ENDDO
+!---
+    IF (gdtt_id > 0) THEN
+      vid = gdtt_id
+    ELSE IF (gdtmaf_id > 0) THEN
+      vid = gdtmaf_id
+    ELSE IF (old_id > 0) THEN
+      vid = old_id
+    ELSE
+      CALL histerr (3, 'flinopen', 'No time axis found',' ',' ')
+    ENDIF
+!---
+    ALLOCATE(vec_tmp(ttm))
+    iret = NF90_GET_VAR (fid,vid,vec_tmp,start=(/ 1 /),count=(/ ttm /))
+    itaus(1:ttm) = NINT(vec_tmp(1:ttm))
+    DEALLOCATE(vec_tmp)
+!---
+    IF (check) WRITE(*,*) 'flinopen 5.1 Times ',itaus
+!---
+!-- Getting all the details for the time axis
+!---
+!-- Find the calendar
+    calendar = ''
+    iret = NF90_GET_ATT (fid,gdtmaf_id,'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar(calendar)
+    ENDIF
+!--
+    units = ''
+    iret = NF90_GET_ATT (fid,vid,'units',units)
+    IF (gdtt_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+!-----
+      iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)
+    ELSE IF (gdtmaf_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+!-----
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+    ELSE IF (old_id > 0) THEN
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)
+!-----
+      day = INT(r_day)
+      month = INT(r_month)
+      year = INT(r_year)
+!-----
+      CALL ymds2ju (year, month, day, sec, date0)
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinopen 6.0 File opened', date0, dt
+!---------------------------
+END SUBROUTINE flinopen_work
+!-
+!===
+!-
+SUBROUTINE flininfo (filename, iim, jjm, llm, ttm, fid_out)
+!---------------------------------------------------------------------
+!- This subroutine allows to get some information.
+!- It is usualy done within flinopen but the user may want to call
+!- it before in order to allocate the space needed to extract the
+!- data from the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, lll
+  INTEGER :: xid, yid, zid, tid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name = filename(1:lll)//'.nc'
+  ELSE
+    name = filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_OPEN (name, NF90_NOWRITE, fid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL histerr(3, 'flininfo','Could not open file :',TRIM(name),' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                      nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    IF (check) WRITE(*,*) &
+      'flininfo - getting axname',iv,axname,lll
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1) ) THEN
+      xid = iv; iim = lll;
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1) ) THEN
+      yid = iv; jjm = lll;
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1) ) THEN
+      zid = iv; llm = lll;
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1) ) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flininfo', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!----------------------
+END SUBROUTINE flininfo
+!-
+!===
+!-
+SUBROUTINE flinput_r1d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r1d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r1d
+!-
+!===
+!-
+SUBROUTINE flinput_r2d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r2d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r2d
+!-
+!===
+!-
+SUBROUTINE flinput_r3d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r3d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r3d
+!-
+!===
+!-
+SUBROUTINE flinput_r4d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r4d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r4d
+!-
+!===
+!-
+SUBROUTINE flinput_mat &
+  (fid_in,varname,iim,nlonid,jjm,nlatid, &
+                  llm,zdimid,ttm,tdimid,fid,ncvarid,ndim)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  INTEGER :: fid, ncvarid, ndim
+!-
+! LOCAL
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  w_sta(1:4) = (/      1,      1,  1,  1 /)
+  w_len(1:2) = (/    iim,    jjm /)
+  w_dim(1:2) = (/ nlonid, nlatid /)
+!-
+  IF ( (llm > 0).AND.(ttm > 0) ) THEN
+    ndim = 4
+    w_len(3:4) = (/    llm,    ttm /)
+    w_dim(3:4) = (/ zdimid, tdimid /)
+  ELSE IF (llm > 0) THEN
+    ndim = 3
+    w_dim(3) = zdimid
+    w_len(3) = llm
+  ELSE IF (ttm > 0) THEN
+    ndim = 3
+    w_dim(3) = tdimid
+    w_len(3) = ttm
+  ELSE
+    ndim = 2
+  ENDIF
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid)
+  iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname))
+  iret = NF90_ENDDEF  (fid)
+!--------------------------
+END  SUBROUTINE flinput_mat
+!-
+!===
+!-
+SUBROUTINE flinput_scal &
+  (fid_in, varname, iim, nlonid, jjm, nlatid, &
+                    llm, zdimid, ttm, tdimid, var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: fid, iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var,KIND=4))
+  iret = NF90_ENDDEF  (fid)
+!---------------------------
+END  SUBROUTINE flinput_scal
+!-
+!===
+!-
+SUBROUTINE flinget_r1d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:)
+!-
+  INTEGER :: jl, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO ji=1,SIZE(var,1)
+    jl=jl+1
+    var(ji) = buff_tmp(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r1d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r2d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r2d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r3d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r3d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r4d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r4d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_mat &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
+   itau_fin, iideb, iilen, jjdeb, jjlen, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- It is checked that the dimensions of the variable to be read
+!- correspond to what the user requested when he specified
+!- iim, jjm and llm. The only exception which is allowed is
+!- for compressed data where the horizontal grid is not expected
+!- to be iim x jjm.
+!-
+!- If variable is of size zero a global attribute is read.
+!- This global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-            For the moment this is done on indexes
+!-            but it should be in the physical space.
+!-            If there is no time-axis in the file then use a
+!-            itau_fin < itau_dep, this will tell flinget not to
+!-            expect a time-axis in the file.
+!- iideb    : index i for zoom
+!- iilen    : length of zoom
+!- jjdeb    : index j for zoom
+!- jjlen    : length of zoom
+!-
+!- OUTPUT
+!-
+!- var      : array that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm
+  INTEGER :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
+  REAL :: var(:)
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+  INTEGER :: vid, cvid, clen
+  CHARACTER(LEN=70) :: str1
+  CHARACTER(LEN=250) :: att_n, tmp_n
+  CHARACTER(LEN=5) :: axs_l
+  INTEGER :: tmp_i
+  REAL,SAVE :: mis_v=0.
+  REAL :: tmp_r
+  INTEGER :: ndims, x_typ, nb_atts
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
+  INTEGER :: i, nvars, i2d, cnd
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp
+  LOGICAL :: uncompress = .FALSE.
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
+    WRITE(*,*) &
+    'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
+    iim, jjm, llm, ttm, itau_dep, itau_fin
+    WRITE(*,*) &
+    'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
+    iideb, iilen, jjdeb, jjlen
+  ENDIF
+!-
+  uncompress = .FALSE.
+!-
+! 1.0 We get first all the details on this variable from the file
+!-
+  nvars = ncnbva(fid_in)
+!-
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  IF (vid < 0 .OR. iret /= NF90_NOERR) THEN
+    CALL histerr (3,'flinget', &
+      'Variable '//TRIM(varname)//' not found in file',' ',' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE_VARIABLE (fid, vid, &
+           ndims=ndims, dimids=dimids, nAtts=nb_atts)
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid, vid :', fid, vid
+    WRITE(*,*) &
+    'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
+    ndims, dimids(1:ndims), nb_atts
+  ENDIF
+!-
+  w_dim(:) = 0
+  DO i=1,ndims
+    iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
+  ENDDO
+  IF (check) WRITE(*,*) &
+    'flinget_mat : w_dim :', w_dim(1:ndims)
+!-
+  mis_v = 0.0; axs_l = ' ';
+!-
+  IF (nb_atts > 0) THEN
+    IF (check) THEN
+      WRITE(*,*) 'flinget_mat : attributes for variable :'
+    ENDIF
+  ENDIF
+  DO i=1,nb_atts
+    iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)
+    iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)
+    CALL strlowercase (att_n)
+    IF      (    (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) &
+             .OR.(x_typ == NF90_BYTE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i
+      ENDIF
+    ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r
+      ENDIF
+      IF (index(att_n,'missing_value') > 0) THEN
+        mis_v = tmp_r
+      ENDIF
+    ELSE
+      tmp_n = ''
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
+      ENDIF
+      IF (index(att_n,'axis') > 0) THEN
+        axs_l = tmp_n
+      ENDIF
+    ENDIF
+  ENDDO
+!?
+!!!!!!!!!! We will need a verification on the type of the variable
+!?
+!-
+! 2.0 The dimensions are analysed to determine what is to be read
+!-
+! 2.1 the longitudes
+!-
+  IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN
+!---
+!-- There is a possibility that we have to deal with a compressed axis !
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), &
+             name=tmp_n, len=clen)
+    iret = NF90_INQ_VARID (fid, tmp_n, cvid)
+!---
+    IF (check) WRITE(*,*) &
+      'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR
+!---
+!-- If we have an axis which has the same name
+!-- as the dimension we can see if it is compressed
+!---
+!-- TODO TODO for zoom2d
+!---
+    IF (iret == NF90_NOERR) THEN
+      iret = NF90_GET_ATT (fid, cvid, 'compress', str1)
+!-----
+      IF (iret == NF90_NOERR) THEN
+        iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)
+!-------
+        IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN
+          CALL histerr (3,'flinget', &
+            'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &
+            'Either it has too many dimensions'// &
+            ' or it is not of type integer', ' ')
+        ELSE
+!---------
+!-------- Let us see if we already have that index table
+!---------
+          IF (    (cind_len /= clen).OR.(cind_vid /= cvid) &
+              .OR.(cind_fid /= fid) ) THEN
+            IF (ALLOCATED(cindex))   DEALLOCATE(cindex)
+            ALLOCATE(cindex(clen))
+            cind_len = clen
+            cind_vid = cvid
+            cind_fid = fid
+            iret = NF90_GET_VAR (fid, cvid, cindex)
+          ENDIF
+!---------
+!-------- In any case we need to set the slab of data to be read
+!---------
+          uncompress = .TRUE.
+          w_sta(1) = 1
+          w_len(1) = clen
+          i2d = 1
+        ENDIF
+      ELSE
+        str1 = 'The horizontal dimensions of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'is not compressed and does not'// &
+          ' correspond to the requested size',' ')
+      ENDIF
+    ELSE
+      IF (w_dim(1) /= iim) THEN
+        str1 = 'The longitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+      IF (w_dim(2) /= jjm) THEN
+        str1 = 'The latitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+    ENDIF
+  ELSE
+    w_sta(1:2) = (/ iideb, jjdeb /)
+    w_len(1:2) = (/ iilen, jjlen /)
+    i2d = 2
+  ENDIF
+!-
+! 2.3 Now the difficult part, the 3rd dimension which can be
+! time or levels.
+!-
+! Priority is given to the time axis if only three axes are present.
+!-
+  IF (ndims > i2d) THEN
+!---
+!-- 2.3.1 We have a vertical axis
+!---
+    IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN
+!-----
+      IF (w_dim(i2d+1) /= llm) THEN
+        CALL histerr (3,'flinget', &
+          'The vertical dimension of '//varname, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ELSE
+        w_sta(i2d+1) = 1
+        IF (llm > 0) THEN
+          w_len(i2d+1) = llm
+        ELSE
+          w_len(i2d+1) = w_sta(i2d+1)
+        ENDIF
+      ENDIF
+!-----
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF      (ndims /= i2d+2) THEN
+          CALL histerr (3,'flinget', &
+            'You attempt to read a time slab', &
+            'but there is no time axis on this variable', varname)
+        ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN
+          w_sta(i2d+2) = itau_dep
+          w_len(i2d+2) = itau_fin-itau_dep+1
+        ELSE
+          CALL histerr (3,'flinget', &
+            'The time step you try to read is not', &
+            'in the file (1)', varname)
+        ENDIF
+      ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN
+        CALL histerr (3,'flinget', &
+          'There is a time axis in the file but no', &
+          'time step give in the call', varname)
+      ELSE
+        w_sta(i2d+2) = 1
+        w_len(i2d+2) = 1
+      ENDIF
+    ELSE
+!-----
+!---- 2.3.2 We do not have any vertical axis
+!-----
+      IF (ndims == i2d+2) THEN
+        CALL histerr (3,'flinget', &
+          'The file contains 4 dimensions', &
+          'but only 3 are requestes for variable ', varname)
+      ENDIF
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF (ndims == i2d+1) THEN
+          IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN
+            w_sta(i2d+1) = itau_dep
+            w_len(i2d+1) = itau_fin-itau_dep+1
+          ELSE
+            CALL histerr (3,'flinget', &
+              'The time step you try to read is not', &
+              'in the file (2)', varname)
+          ENDIF
+        ELSE
+          CALL histerr (3,'flinget', &
+            'From your input you sould have 3 dimensions', &
+            'in the file but there are 4', varname)
+        ENDIF
+      ELSE
+        IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN
+          CALL histerr (3,'flinget', &
+            'There is a time axis in the file but no', &
+            'time step given in the call', varname)
+        ELSE
+          w_sta(i2d+1) = 1
+          w_len(i2d+1) = 1
+        ENDIF
+      ENDIF
+    ENDIF
+  ELSE
+!---
+!-- 2.3.3 We do not have any vertical axis
+!---
+    w_sta(i2d+1:i2d+2) = (/ 0, 0 /)
+    w_len(i2d+1:i2d+2) = (/ 0, 0 /)
+  ENDIF
+!-
+! 3.0 Reading the data
+!-
+  IF (check) WRITE(*,*) &
+    'flinget_mat 3.0 : ', uncompress, w_sta, w_len
+!---
+  IF (uncompress) THEN
+!---
+    IF (ALLOCATED(var_tmp)) THEN
+      IF (SIZE(var_tmp) < clen) THEN
+        DEALLOCATE(var_tmp)
+        ALLOCATE(var_tmp(clen))
+      ENDIF
+    ELSE
+      ALLOCATE(var_tmp(clen))
+    ENDIF
+!---
+    iret = NF90_GET_VAR (fid, vid, var_tmp, &
+             start=w_sta(:), count=w_len(:))
+!---
+    var(:) = mis_v
+    var(cindex(:)) = var_tmp(:)
+!---
+  ELSE
+    iret = NF90_GET_VAR (fid, vid, var, &
+             start=w_sta(:), count=w_len(:))
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
+!--------------------------
+END  SUBROUTINE flinget_mat
+!-
+!===
+!-
+SUBROUTINE flinget_scal &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- If variable is of size zero a global attribute is read. This
+!- global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-           For the moment this is done on indeces but it should be
+!-           in the physical space
+!-           If there is no time-axis in the file then use a
+!-           itau_fin < itau_dep, this will tell flinget not to
+!-           expect a time-axis in the file.
+!-
+!- OUTPUT
+!-
+!- var      : scalar that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) THEN
+    WRITE (*,*) 'flinget_scal in file with id ',fid_in
+  ENDIF
+!-
+  fid = ncids(fid_in)
+!-
+! 1.0 Reading a global attribute
+!-
+  iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
+!---------------------------
+END  SUBROUTINE flinget_scal
+!-
+!===
+!-
+SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
+!---------------------------------------------------------------------
+!- This subroutine explores the file in order to find
+!- the coordinate according to a number of rules
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in, vid, ndim
+  CHARACTER(LEN=3) :: axtype
+!-
+! LOCAL
+!-
+  INTEGER :: iv, iret, dimnb
+  CHARACTER(LEN=40) :: dimname, dimuni1, dimuni2, dimuni3
+  CHARACTER(LEN=80) :: str1
+  LOGICAL :: found_rule = .FALSE.
+!---------------------------------------------------------------------
+  vid = -1
+!-
+! Make sure all strings are invalid
+!-
+  dimname = '?-?'
+  dimuni1 = '?-?'
+  dimuni2 = '?-?'
+  dimuni3 = '?-?'
+!-
+! First rule : we look for the correct units
+! lon : east
+! lat : north
+! We make an exact check as it would be too easy to mistake
+! some units by just comparing the substrings.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimuni1 = 'degree_e'
+    dimuni2 = 'degrees_e'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimuni1 = 'degree_n'
+    dimuni2 = 'degrees_n'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimuni1 = 'm'
+    dimuni2 = 'km'
+    dimuni3 = 'hpa'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1 = ''
+      iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
+      IF (iret == NF90_NOERR) THEN
+        CALL strlowercase (str1)
+        IF (    (INDEX(str1, TRIM(dimuni1)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN
+          vid = iv
+          iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Second rule : we find specific names :
+! lon : nav_lon
+! lat : nav_lat
+! Here we can check if we find the substring as the
+! names are more specific.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimname = 'nav_lon lon longitude'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimname = 'nav_lat lat latitude'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimname = 'plev level depth deptht'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1=''
+      iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                    name=str1, ndims=ndim)
+      IF (INDEX(dimname,TRIM(str1)) >= 1) THEN
+        vid = iv
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Third rule : we find a variable with the same name as the dimension
+! lon = 1
+! lat = 2
+! lev = 3
+!-
+  IF (vid < 0) THEN
+    SELECTCASE(axtype)
+    CASE ('lon')
+      dimnb = 1
+      found_rule = .TRUE.
+    CASE('lat')
+      dimnb = 2
+      found_rule = .TRUE.
+    CASE('lev')
+      dimnb = 3
+      found_rule = .TRUE.
+    CASE DEFAULT
+      found_rule = .FALSE.
+    END SELECT
+!---
+    IF (found_rule) THEN
+      iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
+      iv = 0
+      DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+        iv = iv+1
+        str1=''
+        iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                      name=str1, ndims=ndim)
+        IF (INDEX(dimname,TRIM(str1)) == 1) THEN
+          vid = iv
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Stop the program if no coordinate was found
+!-
+  IF (vid < 0) THEN
+    CALL histerr (3,'flinfindcood', &
+           'No coordinate axis was found in the file', &
+           'The data in this file can not be used', axtype)
+  ENDIF
+!--------------------------
+END SUBROUTINE flinfindcood
+!-
+!===
+!-
+SUBROUTINE flinclo (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  iret = NF90_CLOSE (ncids(fid_in))
+  ncfileopen(fid_in) = .FALSE.
+!---------------------
+END SUBROUTINE flinclo
+!-
+!===
+!-
+SUBROUTINE flinquery_var(fid_in, varname, exists)
+!---------------------------------------------------------------------
+!- Queries the existance of a variable in the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) varname
+  LOGICAL :: exists
+!-
+  INTEGER :: iret, fid, vid
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  exists = ( (vid >= 0).AND.(iret == NF90_NOERR) )
+!---------------------------
+END SUBROUTINE flinquery_var
+!-
+!===
+!-
+SUBROUTINE flininspect (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! fid : File id to inspect
+!-
+  INTEGER :: fid_in
+!-
+!- LOCAL
+!-
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, in, lll
+  INTEGER :: xid, yid, zid, tid
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                       nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  WRITE (*,*) 'IOIPSL ID                   : ',fid_in
+  WRITE (*,*) 'NetCDF ID                   : ',fid
+  WRITE (*,*) 'Number of dimensions        : ',ndims
+  WRITE (*,*) 'Number of variables         : ',nvars
+  WRITE (*,*) 'Number of global attributes : ',nb_atts
+  WRITE (*,*) 'ID unlimited                : ',id_unlim
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    WRITE (*,*) 'Dimension number : ',iv
+    WRITE (*,*) 'Dimension name   : ',TRIM(axname)
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1)) THEN
+      xid = iv; iim = lll;
+      WRITE (*,*) 'Dimension X size   : ',iim
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1)) THEN
+      yid = iv; jjm = lll;
+      WRITE (*,*) 'Dimension Y size   : ',jjm
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1)) THEN
+      zid = iv; llm = lll;
+      WRITE (*,*) 'Dimension Z size   : ',llm
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1)) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr(3,'flininspect', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!-
+  DO in=1,nvars
+    iret = NF90_INQUIRE_VARIABLE (fid, in, &
+             name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts)
+    WRITE (*,*) 'Variable number  ------------ > ', in
+    WRITE (*,*) 'Variable name        : ', TRIM(name)
+    WRITE (*,*) 'Number of dimensions : ', ndims
+    WRITE (*,*) 'Dimensions ID''s     : ', idimid(1:ndims)
+    WRITE (*,*) 'Number of attributes : ', nb_atts
+  ENDDO
+!-------------------------
+END SUBROUTINE flininspect
+!-
+!===
+!-
+END MODULE flincom
Index: IOIPSL/tags/v2_1_9/src/fliocom.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/fliocom.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/fliocom.f90	(revision 715)
@@ -0,0 +1,5044 @@
+MODULE fliocom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE netcdf
+!-
+USE defprec
+USE calendar,  ONLY : lock_calendar,ioget_calendar, &
+ &                    ioconf_calendar,ju2ymds,ymds2ju
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop,  ONLY : strlowercase
+!-
+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)
+!!
+!! 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 : 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','REP32')
+      m_c = NF90_CLOBBER
+    CASE('32')
+      m_c = NF90_NOCLOBBER
+    CASE('64')
+      m_c = IOR(NF90_NOCLOBBER,NF90_64BIT_OFFSET)
+    CASE('REP64')
+      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+    CASE DEFAULT
+      m_c = NF90_NOCLOBBER
+    END SELECT
+  ELSE
+    m_c = NF90_NOCLOBBER
+  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)
+!---------------------------------------------------------------------
+  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
+!---------------------------------------------------------------------
+  CALL flio_udv &
+ &  (f_i,0,v_n,(/0/),v_t, &
+ &   axis,standard_name,long_name,units,valid_min,valid_max)
+!------------------------
+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)
+!---------------------------------------------------------------------
+  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
+!---------------------------------------------------------------------
+  CALL flio_udv &
+ &  (f_i,SIZE(v_d),v_n,v_d,v_t, &
+ &   axis,standard_name,long_name,units,valid_min,valid_max)
+!------------------------
+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)
+!---------------------------------------------------------------------
+  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
+!-
+  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
+      IF      (v_t == flio_i) THEN
+        IF (i_std == i_8) THEN
+!-------- Not yet supported by NETCDF
+!-------- m_k = flio_i8
+          m_k = flio_i4
+        ELSE
+          m_k = flio_i4
+        ENDIF
+      ELSE IF (v_t == flio_r) THEN
+        IF (r_std == r_8) THEN
+          m_k = flio_r8
+        ELSE
+          m_k = flio_r4
+        ENDIF
+      ELSE
+        m_k = v_t
+      ENDIF
+    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
+      i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',valid_min)
+    ENDIF
+    IF (PRESENT(valid_max)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',valid_max)
+    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: IOIPSL/tags/v2_1_9/src/getincom.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/getincom.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/getincom.f90	(revision 715)
@@ -0,0 +1,1975 @@
+MODULE getincom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE errioipsl, ONLY : ipslerr
+USE stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin, getin_dump
+!-
+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 run.def 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 run.def 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,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 run.def
+! 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
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: allread=0
+  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) = 'run.def'
+    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='run.def.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
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
+!-
+  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 the run.def.'
+        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 run.def 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: IOIPSL/tags/v2_1_9/src/histcom.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/histcom.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/histcom.f90	(revision 715)
@@ -0,0 +1,2514 @@
+MODULE histcom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+  USE netcdf
+!-
+  USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase
+  USE mathelp,  ONLY : mathop,moycum,buildop
+  USE fliocom,  ONLY : flio_dom_file,flio_dom_att
+  USE calendar
+  USE errioipsl, ONLY : ipslerr,ipsldbg
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: histbeg,histdef,histhori,histvert,histend, &
+ &          histwrite,histclo,histsync,ioconf_modname
+!---------------------------------------------------------------------
+!- Some confusing vocabulary in this code !
+!- =========================================
+!-
+!- A REGULAR grid is a grid which is i,j indexes
+!- and thus it is stored in a 2D matrix.
+!- This is opposed to a IRREGULAR grid which is only in a vector
+!- and where we do not know which neighbors we have.
+!- As a consequence we need the bounds for each grid-cell.
+!-
+!- A RECTILINEAR grid is a special case of a regular grid
+!- in which all longitudes for i constant are equal
+!- and all latitudes for j constant.
+!- In other words we do not need the full 2D matrix
+!- to describe the grid, just two vectors.
+!---------------------------------------------------------------------
+  INTERFACE histwrite
+!---------------------------------------------------------------------
+!- The "histwrite" routines will give the data to the I/O system.
+!- It will trigger the operations to be performed,
+!- and the writting to the file if needed
+!-
+!- We test for the work to be done at this time here so that at a
+!- later stage we can call different operation and write subroutine
+!- for the REAL and INTEGER interfaces
+!-
+!- INPUT
+!- pfileid  : The ID of the file on which this variable is to be,
+!-            written. The variable should have been defined in
+!-            this file before.
+!- pvarname : The short name of the variable
+!- pitau    : Current timestep
+!- pdata    : The variable, I mean the real data !
+!- nbindex  : The number of indexes provided. If it is equal to
+!-            the size of the full field as provided in histdef
+!-            then nothing is done.
+!- nindex   : The indices used to expand the variable (pdata)
+!-            onto the full field.
+!---------------------------------------------------------------------
+!- histwrite - we have to prepare different type of fields :
+!-             real and integer, 1,2 or 3D
+    MODULE PROCEDURE histwrite_r1d,histwrite_r2d,histwrite_r3d
+  END INTERFACE
+!-
+  INTERFACE histbeg
+    MODULE PROCEDURE histbeg_totreg,histbeg_regular,histbeg_irregular
+  END INTERFACE
+!-
+  INTERFACE histhori
+    MODULE PROCEDURE histhori_regular,histhori_irregular
+  END INTERFACE
+!-
+! Fixed parameter
+!-
+  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=400, &
+ &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10
+  REAL,PARAMETER :: missing_val=nf90_fill_real
+!-
+  INTEGER :: bufftmp_max(nb_files_max) = 1
+!-
+! Time variables
+!-
+  INTEGER,SAVE :: itau0(nb_files_max)=0
+  REAL,DIMENSION(nb_files_max),SAVE ::date0,deltat
+!-
+! Counter of elements
+!-
+  INTEGER,SAVE :: nb_files=0
+  INTEGER,DIMENSION(nb_files_max),SAVE :: nb_var=0,nb_tax=0
+!-
+! DOMAIN IDs for files
+!-
+  INTEGER,DIMENSION(nb_files_max),SAVE :: dom_id_svg=-1
+!-
+! NETCDF IDs for files and axes
+!-
+  INTEGER,DIMENSION(nb_files_max),SAVE :: ncdf_ids,xid,yid,tid
+!-
+! General definitions in the NETCDF file
+!-
+  INTEGER,DIMENSION(nb_files_max,2),SAVE :: &
+ &   full_size=0,slab_ori,slab_sz
+!-
+! The horizontal axes
+!-
+  INTEGER,SAVE :: nb_hax(nb_files_max)=0
+  CHARACTER(LEN=25),SAVE :: hax_name(nb_files_max,nb_hax_max,2)
+!-
+! The vertical axes
+!-
+  INTEGER,SAVE :: nb_zax(nb_files_max)=0
+  INTEGER,DIMENSION(nb_files_max,nb_zax_max),SAVE :: &
+  &  zax_size,zax_ids
+  CHARACTER(LEN=20),SAVE :: zax_name(nb_files_max,nb_zax_max)
+!-
+! Informations on each variable
+!-
+  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  nbopp
+  CHARACTER(LEN=20),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  name,unit_name
+  CHARACTER(LEN=80),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  title,fullop
+  CHARACTER(LEN=7),SAVE :: topp(nb_files_max,nb_var_max)
+  CHARACTER(LEN=7),SAVE :: sopps(nb_files_max,nb_var_max,nbopp_max)
+  REAL,SAVE :: scal(nb_files_max,nb_var_max,nbopp_max)
+!- Sizes of the associated grid and zommed area
+  INTEGER,DIMENSION(nb_files_max,nb_var_max,3),SAVE :: &
+ &   scsize,zorig,zsize
+!- Sizes for the data as it goes through the various math operations
+  INTEGER,SAVE :: datasz_in(nb_files_max,nb_var_max,3) = -1
+  INTEGER,SAVE :: datasz_max(nb_files_max,nb_var_max) = -1
+!-
+  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  var_haxid,var_zaxid,var_axid,ncvar_ids
+!-
+  REAL,DIMENSION(nb_files_max,nb_var_max,2),SAVE :: hist_minmax
+  LOGICAL,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE.
+!-
+  REAL,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  freq_opp,freq_wrt
+  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt,point
+!-
+! Book keeping for the buffers
+!-
+  INTEGER,SAVE :: buff_pos=0
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buffer
+  LOGICAL,DIMENSION(nb_files_max),SAVE :: zoom=.FALSE.,regular=.TRUE.
+!-
+! Book keeping of the axes
+!-
+  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  tdimid,tax_last
+  CHARACTER(LEN=40),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
+ &  tax_name
+!-
+! A list of functions which require special action
+! (Needs to be updated when functions are added
+!  but they are well located here)
+!-
+  CHARACTER(LEN=120),SAVE :: &
+ &  indchfun = 'scatter, fill, gather, coll', &
+ &  fuchnbout = 'scatter, fill'
+!- Some configurable variables with locks
+  CHARACTER(LEN=80),SAVE :: model_name='An IPSL model'
+  LOGICAL,SAVE :: lock_modname=.FALSE.
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE histbeg_totreg                 &
+ & (pfilename,pim,plon,pjm,plat,          &
+ &  par_orix,par_szx,par_oriy,par_szy,    &
+ &  pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id)
+!---------------------------------------------------------------------
+!- This is just an interface for histbeg_regular in case when
+!- the user provides plon and plat as vectors.
+!- Obviously this can only be used for very regular grids.
+!-
+!- INPUT
+!-
+!- pfilename : Name of the netcdf file to be created
+!- pim       : Size of arrays in longitude direction
+!- plon      : Coordinates of points in longitude
+!- pjm       : Size of arrays in latitude direction
+!- plat      : Coordinates of points in latitude
+!-
+!- The next 4 arguments allow to define a horizontal zoom
+!- for this file. It is assumed that all variables to come
+!- have the same index space. This can not be assumed for
+!- the z axis and thus we define the zoom in histdef.
+!-
+!- par_orix  : Origin of the slab of data within the X axis (pim)
+!- par_szx   : Size of the slab of data in X
+!- par_oriy  : Origin of the slab of data within the Y axis (pjm)
+!- par_szy   : Size of the slab of data in Y
+!-
+!- pitau0    : time step at which the history tape starts
+!- pdate0    : The Julian date at which the itau was equal to 0
+!- pdeltat   : Time step in seconds. Time step of the counter itau
+!-             used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid   : ID of the horizontal grid
+!- pfileid   : ID of the netcdf file
+!-
+!- Optional INPUT arguments
+!-
+!- domain_id       : Domain identifier
+!-
+!- TO DO
+!-
+!- This package should be written in f90
+!- and use the following features :
+!-    - structures for the meta-data of the files and variables
+!-    - memory allocation as needed
+!-    - Pointers
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim),INTENT(IN) :: plon
+  REAL,DIMENSION(pjm),INTENT(IN) :: plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: pfileid,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  REAL,ALLOCATABLE,DIMENSION(:,:) :: lon_tmp,lat_tmp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_totreg"
+!-
+  ALLOCATE(lon_tmp(pim,pjm),lat_tmp(pim,pjm))
+!-
+  lon_tmp(:,:) = SPREAD(plon(:),2,pjm)
+  lat_tmp(:,:) = SPREAD(plat(:),1,pim)
+!-
+  CALL histbeg_regular &
+ &  (pfilename,pim,lon_tmp,pjm,lat_tmp, &
+ &   par_orix,par_szx,par_oriy,par_szy, &
+ &   pitau0,pdate0,pdeltat,phoriid,pfileid, &
+ &   .TRUE.,domain_id)
+!-
+  DEALLOCATE(lon_tmp,lat_tmp)
+!----------------------------
+END SUBROUTINE histbeg_totreg
+!===
+SUBROUTINE histbeg_regular &
+ & (pfilename,pim,plon,pjm,plat,           &
+ &  par_orix,par_szx,par_oriy,par_szy,     &
+ &  pitau0,pdate0,pdeltat,phoriid,pfileid, &
+ &  opt_rectilinear,domain_id)
+!---------------------------------------------------------------------
+!- This subroutine initializes a netcdf file and returns the ID.
+!- It will set up the geographical space on which the data will be
+!- stored and offers the possibility of seting a zoom.
+!- It also gets the global parameters into the I/O subsystem.
+!-
+!- INPUT
+!-
+!- pfilename : Name of the netcdf file to be created
+!- pim       : Size of arrays in longitude direction
+!- plon      : Coordinates of points in longitude
+!- pjm       : Size of arrays in latitude direction
+!- plat      : Coordinates of points in latitude
+!-
+!- The next 4 arguments allow to define a horizontal zoom
+!- for this file. It is assumed that all variables to come
+!- have the same index space. This can not be assumed for
+!- the z axis and thus we define the zoom in histdef.
+!-
+!- par_orix  : Origin of the slab of data within the X axis (pim)
+!- par_szx   : Size of the slab of data in X
+!- par_oriy  : Origin of the slab of data within the Y axis (pjm)
+!- par_szy   : Size of the slab of data in Y
+!-
+!- pitau0    : time step at which the history tape starts
+!- pdate0    : The Julian date at which the itau was equal to 0
+!- pdeltat   : Time step in seconds. Time step of the counter itau
+!-             used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid   : ID of the horizontal grid
+!- pfileid   : ID of the netcdf file
+!-
+!- Optional INPUT arguments
+!-
+!- opt_rectilinear : If true we know the grid is rectilinear
+!- domain_id       : Domain identifier
+!-
+!- TO DO
+!-
+!- This package should be written in F90 and use the following
+!- feature :
+!-   - structures for the meta-data of the files and variables
+!-   - memory allocation as needed
+!-   - Pointers
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim,pjm),INTENT(IN) :: plon,plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: pfileid,phoriid
+  LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: ncid,iret
+  CHARACTER(LEN=120) :: file
+  CHARACTER(LEN=30) :: timenow
+  LOGICAL :: rectilinear
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  nb_files = nb_files+1
+  pfileid  = nb_files
+!-
+! 1.0 Transfering into the common for future use
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_regular 1.0"
+!-
+  itau0(pfileid) = pitau0
+  date0(pfileid) = pdate0
+  deltat(pfileid) = pdeltat
+!-
+  IF (PRESENT(opt_rectilinear)) THEN
+    rectilinear = opt_rectilinear
+  ELSE
+    rectilinear = .FALSE.
+  ENDIF
+!-
+! 2.0 Initializes all variables for this file
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_regular 2.0"
+!-
+  IF (nb_files > nb_files_max) THEN
+    CALL ipslerr (3,"histbeg", &
+   &  'Table of files too small. You should increase nb_files_max', &
+   &  'in histcom.f90 in order to accomodate all these files',' ')
+  ENDIF
+!-
+  nb_var(pfileid) = 0
+  nb_tax(pfileid) = 0
+  nb_hax(pfileid) = 0
+  nb_zax(pfileid) = 0
+!-
+  slab_ori(pfileid,1:2) = (/ par_orix,par_oriy /)
+  slab_sz(pfileid,1:2)  = (/ par_szx, par_szy  /)
+!-
+! 3.0 Opening netcdf file and defining dimensions
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_regular 3.0"
+!-
+! Add DOMAIN number and ".nc" suffix in file name if needed
+!-
+  file = pfilename
+  CALL flio_dom_file (file,domain_id)
+!-
+  iret = NF90_CREATE (file,NF90_CLOBBER,ncid)
+!-
+  IF (rectilinear) THEN
+    iret = NF90_DEF_DIM (ncid,'lon',par_szx,xid(nb_files))
+    iret = NF90_DEF_DIM (ncid,'lat',par_szy,yid(nb_files))
+  ELSE
+    iret = NF90_DEF_DIM (ncid,'x',par_szx,xid(nb_files))
+    iret = NF90_DEF_DIM (ncid,'y',par_szy,yid(nb_files))
+  ENDIF
+!-
+! 4.0 Declaring the geographical coordinates and other attributes
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_regular 4.0"
+!-
+! 4.3 Global attributes
+!-
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file))
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name))
+  lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! 5.0 Saving some important information on this file in the common
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_regular 5.0"
+!-
+  IF (PRESENT(domain_id)) THEN
+    dom_id_svg(pfileid) = domain_id
+  ENDIF
+  ncdf_ids(pfileid) = ncid
+  full_size(pfileid,1:2) = (/ pim,pjm /)
+!-
+! 6.0 storing the geographical coordinates
+!-
+  zoom(pfileid) = (pim /= par_szx).OR.(pjm /= par_szy)
+  regular(pfileid)=.TRUE.
+!-
+  CALL histhori_regular (pfileid,pim,plon,pjm,plat, &
+ &  ' ' ,'Default grid',phoriid,rectilinear)
+!-----------------------------
+END SUBROUTINE histbeg_regular
+!===
+SUBROUTINE histbeg_irregular &
+ &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds,   &
+ &   pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id)
+!---------------------------------------------------------------------
+!- This subroutine initializes a netcdf file and returns the ID.
+!- This version is for totaly irregular grids. In this case all
+!- all the data comes in as vectors and for the grid we have
+!- the coordinates of the 4 corners.
+!- It also gets the global parameters into the I/O subsystem.
+!-
+!- INPUT
+!-
+!- pfilename   : Name of the netcdf file to be created
+!- pim         : Size of arrays in longitude direction
+!- plon        : Coordinates of points in longitude
+!- plon_bounds : The 2 corners of the grid in longitude
+!- plat        : Coordinates of points in latitude
+!- plat_bounds : The 2 corners of the grid in latitude
+!-
+!- pitau0    : time step at which the history tape starts
+!- pdate0    : The Julian date at which the itau was equal to 0
+!- pdeltat   : Time step in seconds. Time step of the counter itau
+!-             used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid   : ID of the horizontal grid
+!- pfileid   : ID of the netcdf file
+!-
+!- Optional INPUT arguments
+!-
+!- domain_id       : Domain identifier
+!-
+!- TO DO
+!-
+!- This package should be written in F90 and use the following
+!- feature :
+!-   - structures for the meta-data of the files and variables
+!-   - memory allocation as needed
+!-   - Pointers
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim
+  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: pfileid,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: ncid,iret
+  CHARACTER(LEN=120) :: file
+  CHARACTER(LEN=30) :: timenow
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  nb_files = nb_files+1
+  pfileid  = nb_files
+!-
+! 1.0 Transfering into the common for future use
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_irregular 1.0"
+!-
+  itau0(pfileid) = pitau0
+  date0(pfileid) = pdate0
+  deltat(pfileid) = pdeltat
+!-
+! 2.0 Initializes all variables for this file
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_irregular 2.0"
+!-
+  IF (nb_files > nb_files_max) THEN
+    CALL ipslerr (3,"histbeg", &
+   &  'Table of files too small. You should increase nb_files_max', &
+   &  'in histcom.f90 in order to accomodate all these files',' ')
+  ENDIF
+!-
+  nb_var(pfileid) = 0
+  nb_tax(pfileid) = 0
+  nb_hax(pfileid) = 0
+  nb_zax(pfileid) = 0
+!-
+  slab_ori(pfileid,1:2) = (/ 1,1 /)
+  slab_sz(pfileid,1:2)  = (/ pim,1 /)
+!-
+! 3.0 Opening netcdf file and defining dimensions
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_irregular 3.0"
+!-
+! Add DOMAIN number and ".nc" suffix in file name if needed
+!-
+  file  = pfilename
+  CALL flio_dom_file (file,domain_id)
+!-
+  iret = NF90_CREATE (file,NF90_CLOBBER,ncid)
+!-
+  iret = NF90_DEF_DIM (ncid,'x',pim,xid(nb_files))
+  yid(nb_files) = 0
+!-
+! 4.0 Declaring the geographical coordinates and other attributes
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_irregular 4.0"
+!-
+! 4.3 Global attributes
+!-
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file))
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name))
+  lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! 5.0 Saving some important information on this file in the common
+!-
+  IF (l_dbg) WRITE(*,*) "histbeg_irregular 5.0"
+!-
+  IF (PRESENT(domain_id)) THEN
+    dom_id_svg(pfileid) = domain_id
+  ENDIF
+  ncdf_ids(pfileid) = ncid
+  full_size(pfileid,1:2) = (/ pim,1 /)
+!-
+! 6.0 storing the geographical coordinates
+!-
+  zoom(pfileid)=.FALSE.
+  regular(pfileid)=.FALSE.
+!-
+  CALL histhori_irregular &
+ &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, &
+ &   ' ' ,'Default grid',phoriid)
+!-------------------------------
+END SUBROUTINE histbeg_irregular
+!===
+SUBROUTINE histhori_regular &
+ &  (pfileid,pim,plon,pjm,plat,phname,phtitle,phid,opt_rectilinear)
+!---------------------------------------------------------------------
+!- This subroutine is made to declare a new horizontale grid.
+!- It has to have the same number of points as
+!- the original and thus in this routine we will only
+!- add two variable (longitude and latitude).
+!- Any variable in the file can thus point to this pair
+!- through an attribute. This routine is very usefull
+!- to allow staggered grids.
+!-
+!- INPUT
+!-
+!- pfileid : The id of the file to which the grid should be added
+!- pim     : Size in the longitude direction
+!- plon    : The longitudes
+!- pjm     : Size in the latitude direction
+!- plat    : The latitudes
+!- phname  : The name of grid
+!- phtitle : The title of the grid
+!-
+!- OUTPUT
+!-
+!- phid    : Id of the created grid
+!-
+!- OPTIONAL
+!-
+!- opt_rectilinear : If true we know the grid is rectilinear.
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pim,pjm
+  REAL,INTENT(IN),DIMENSION(pim,pjm) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+  LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear
+!-
+  CHARACTER(LEN=25) :: lon_name,lat_name
+  CHARACTER(LEN=80) :: tmp_title,tmp_name
+  INTEGER :: ndim
+  INTEGER,DIMENSION(2) :: dims
+  INTEGER :: nlonid,nlatid
+  INTEGER :: orix,oriy,par_szx,par_szy
+  INTEGER :: iret,ncid
+  LOGICAL :: rectilinear
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Check that all fits in the buffers
+!-
+  IF (    (pim /= full_size(pfileid,1)) &
+    & .OR.(pjm /= full_size(pfileid,2)) ) THEN
+    CALL ipslerr (3,"histhori", &
+   &  'The new horizontal grid does not have the same size', &
+   &  'as the one provided to histbeg. This is not yet ', &
+   &  'possible in the hist package.')
+  ENDIF
+!-
+  IF (PRESENT(opt_rectilinear)) THEN
+    rectilinear = opt_rectilinear
+  ELSE
+    rectilinear = .FALSE.
+  ENDIF
+!-
+! 1.1 Create all the variables needed
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_regular 1.0"
+!-
+  ncid = ncdf_ids(pfileid)
+!-
+  ndim = 2
+  dims(1:2) = (/ xid(pfileid),yid(pfileid) /)
+!-
+  tmp_name = phname
+  IF (rectilinear) THEN
+    IF (nb_hax(pfileid) == 0) THEN
+      lon_name = 'lon'
+      lat_name = 'lat'
+    ELSE
+      lon_name = 'lon_'//TRIM(tmp_name)
+      lat_name = 'lat_'//TRIM(tmp_name)
+    ENDIF
+  ELSE
+    IF (nb_hax(pfileid) == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(tmp_name)
+      lat_name = 'nav_lat_'//TRIM(tmp_name)
+    ENDIF
+  ENDIF
+!-
+! 1.2 Save the informations
+!-
+  phid =  nb_hax(pfileid)+1
+  nb_hax(pfileid) = phid
+!-
+  hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /)
+  tmp_title = phtitle
+!-
+! 2.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_regular 2.0"
+!-
+  IF (rectilinear) THEN
+    ndim = 1
+    dims(1:1) = (/ xid(pfileid) /)
+  ENDIF
+  iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid)
+  IF (rectilinear) THEN
+    iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X")
+  ENDIF
+  iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude")
+  iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', &
+ &                     REAL(MINVAL(plon),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlonid,'valid_max', &
+ &                     REAL(MAXVAL(plon),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlonid,'long_name',"Longitude")
+  iret = NF90_PUT_ATT (ncid,nlonid,'nav_model',TRIM(tmp_title))
+!-
+! 3.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_regular 3.0"
+!-
+  IF (rectilinear) THEN
+    ndim = 1
+    dims(1:1) = (/ yid(pfileid) /)
+  ENDIF
+  iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid)
+  IF (rectilinear) THEN
+    iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y")
+  ENDIF
+  iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude")
+  iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', &
+ &                     REAL(MINVAL(plat),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlatid,'valid_max', &
+ &                     REAL(MAXVAL(plat),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlatid,'long_name',"Latitude")
+  iret = NF90_PUT_ATT (ncid,nlatid,'nav_model',TRIM(tmp_title))
+!-
+  iret = NF90_ENDDEF (ncid)
+!-
+! 4.0 storing the geographical coordinates
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_regular 4.0"
+!-
+  orix = slab_ori(pfileid,1)
+  oriy = slab_ori(pfileid,2)
+  par_szx = slab_sz(pfileid,1)
+  par_szy = slab_sz(pfileid,2)
+!-
+! Transfer the longitude
+!-
+  IF (rectilinear) THEN
+    iret = NF90_PUT_VAR (ncid,nlonid,plon(orix:orix+par_szx-1,1))
+  ELSE
+    iret = NF90_PUT_VAR (ncid,nlonid, &
+ &           plon(orix:orix+par_szx-1,oriy:oriy+par_szy-1))
+  ENDIF
+!-
+! Transfer the latitude
+!-
+  IF (rectilinear) THEN
+    iret = NF90_PUT_VAR (ncid,nlatid,plat(1,oriy:oriy+par_szy-1))
+  ELSE
+    iret = NF90_PUT_VAR (ncid,nlatid, &
+ &           plat(orix:orix+par_szx-1,oriy:oriy+par_szy-1))
+  ENDIF
+!-
+  iret = NF90_REDEF (ncid)
+!------------------------------
+END SUBROUTINE histhori_regular
+!===
+SUBROUTINE histhori_irregular &
+ &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, &
+ &   phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- This subroutine is made to declare a new horizontale grid.
+!- It has to have the same number of points as
+!- the original and thus in this routine we will only
+!- add two variable (longitude and latitude).
+!- Any variable in the file can thus point to this pair
+!- through an attribute. This routine is very usefull
+!- to allow staggered grids.
+!-
+!- INPUT
+!-
+!- pfileid     : The id of the file to which the grid should be added
+!- pim         : Size in the longitude direction
+!- plon        : The longitudes
+!- plon_bounds : The boundaries of the grid in longitude
+!- plat        : The latitudes
+!- plat_bounds : Boundaries of the grid in latitude
+!- phname      : The name of grid
+!- phtitle     : The title of the grid
+!-
+!- OUTPUT
+!-
+!- phid    : Id of the created grid
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pim
+  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!-
+  CHARACTER(LEN=25) :: lon_name,lat_name
+  CHARACTER(LEN=30) :: lonbound_name,latbound_name
+  CHARACTER(LEN=80) :: tmp_title,tmp_name,longname
+  INTEGER :: ndim,dims(2)
+  INTEGER :: ndimb,dimsb(2)
+  INTEGER :: nbbounds
+  INTEGER :: nlonid,nlatid,nlonidb,nlatidb
+  INTEGER :: iret,ncid,twoid
+  LOGICAL :: transp = .FALSE.
+  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Check that all fits in the buffers
+!-
+  IF (    (pim /= full_size(pfileid,1)) &
+    & .OR.(full_size(pfileid,2) /= 1) ) THEN
+    CALL ipslerr (3,"histhori", &
+   &  'The new horizontal grid does not have the same size', &
+   &  'as the one provided to histbeg. This is not yet ', &
+   &  'possible in the hist package.')
+  ENDIF
+!-
+! 1.1 Create all the variables needed
+!-
+  IF (l_dbg) WRITE(*,*) 'histhori_irregular 1.0'
+!-
+  ncid = ncdf_ids(pfileid)
+!-
+  IF     (SIZE(plon_bounds,DIM=1) == pim) THEN
+    nbbounds = SIZE(plon_bounds,DIM=2)
+    transp = .TRUE.
+  ELSEIF (SIZE(plon_bounds,DIM=2) == pim) THEN
+    nbbounds = SIZE(plon_bounds,DIM=1)
+    transp = .FALSE.
+  ELSE
+    CALL ipslerr (3,"histhori", &
+   &  'The boundary variable does not have any axis corresponding', &
+   &  'to the size of the longitude or latitude variable', &
+   &  '.')
+  ENDIF
+!-
+  ALLOCATE(bounds_trans(nbbounds,pim))
+!-
+  iret = NF90_DEF_DIM (ncid,'nbnd',nbbounds,twoid)
+  ndim = 1
+  dims(1) = xid(pfileid)
+  ndimb = 2
+  dimsb(1:2) = (/ twoid,xid(pfileid) /)
+!-
+  tmp_name = phname
+  IF (nb_hax(pfileid) == 0) THEN
+    lon_name = 'nav_lon'
+    lat_name = 'nav_lat'
+  ELSE
+    lon_name = 'nav_lon_'//TRIM(tmp_name)
+    lat_name = 'nav_lat_'//TRIM(tmp_name)
+  ENDIF
+  lonbound_name = TRIM(lon_name)//'_bounds'
+  latbound_name = TRIM(lat_name)//'_bounds'
+!-
+! 1.2 Save the informations
+!-
+  phid =  nb_hax(pfileid)+1
+  nb_hax(pfileid) = phid
+!-
+  hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /)
+  tmp_title = phtitle
+!-
+! 2.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_irregular 2.0"
+!-
+  iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid)
+  iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude")
+  iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', &
+ &                     REAL(MINVAL(plon),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlonid,'valid_max', &
+ &                     REAL(MAXVAL(plon),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlonid,'long_name',"Longitude")
+  iret = NF90_PUT_ATT (ncid,nlonid,'nav_model',TRIM(tmp_title))
+!-
+! 2.1 Longitude bounds
+!-
+  iret = NF90_PUT_ATT (ncid,nlonid,'bounds',TRIM(lonbound_name))
+  iret = NF90_DEF_VAR (ncid,lonbound_name,NF90_FLOAT, &
+ &                     dimsb(1:ndimb),nlonidb)
+  longname = 'Boundaries for coordinate variable '//TRIM(lon_name)
+  iret = NF90_PUT_ATT (ncid,nlonidb,'long_name',TRIM(longname))
+!-
+! 3.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_irregular 3.0"
+!-
+  iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid)
+  iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude")
+  iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', &
+ &                     REAL(MINVAL(plat),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlatid,'valid_max', &
+ &                     REAL(MAXVAL(plat),KIND=4))
+  iret = NF90_PUT_ATT (ncid,nlatid,'long_name',"Latitude")
+  iret = NF90_PUT_ATT (ncid,nlatid,'nav_model',TRIM(tmp_title))
+!-
+! 3.1 Latitude bounds
+!-
+  iret = NF90_PUT_ATT (ncid,nlatid,'bounds',TRIM(latbound_name))
+  iret = NF90_DEF_VAR (ncid,latbound_name,NF90_FLOAT, &
+ &                     dimsb(1:ndimb),nlatidb)
+  longname = 'Boundaries for coordinate variable '//TRIM(lat_name)
+  iret = NF90_PUT_ATT (ncid,nlatidb,'long_name',TRIM(longname))
+!-
+  iret = NF90_ENDDEF (ncid)
+!-
+! 4.0 storing the geographical coordinates
+!-
+  IF (l_dbg) WRITE(*,*) "histhori_irregular 4.0"
+!-
+! 4.1 Write the longitude
+!-
+  iret = NF90_PUT_VAR (ncid,nlonid,plon(1:pim))
+!-
+! 4.2 Write the longitude bounds
+!-
+  IF (transp) THEN
+    bounds_trans = TRANSPOSE(plon_bounds)
+  ELSE
+    bounds_trans = plon_bounds
+  ENDIF
+  iret = NF90_PUT_VAR (ncid,nlonidb,bounds_trans(1:nbbounds,1:pim))
+!-
+! 4.3 Write the latitude
+!-
+  iret = NF90_PUT_VAR (ncid,nlatid,plat(1:pim))
+!-
+! 4.4 Write the latitude bounds
+!-
+  IF (transp) THEN
+    bounds_trans = TRANSPOSE(plat_bounds)
+  ELSE
+    bounds_trans = plat_bounds
+  ENDIF
+  iret = NF90_PUT_VAR (ncid,nlatidb,bounds_trans(1:nbbounds,1:pim))
+!-
+  DEALLOCATE(bounds_trans)
+!-
+  iret = NF90_REDEF (ncid)
+!--------------------------------
+END SUBROUTINE histhori_irregular
+!===
+SUBROUTINE histvert (pfileid,pzaxname,pzaxtitle,pzaxunit, &
+ &                   pzsize,pzvalues,pzaxid,pdirect)
+!---------------------------------------------------------------------
+!- This subroutine defines a vertical axis and returns it s id.
+!- It gives the user the possibility to the user to define many
+!- different vertical axes. For each variable defined with histdef a
+!- vertical axis can be specified with by it s ID.
+!-
+!- INPUT
+!-
+!- pfileid  : ID of the file the variable should be archived in
+!- pzaxname : Name of the vertical axis
+!- pzaxtitle: title of the vertical axis
+!- pzaxunit : Units of the vertical axis (no units if blank string)
+!- pzsize   : size of the vertical axis
+!- pzvalues : Coordinate values of the vetical axis
+!-
+!- pdirect  : is an optional argument which allows to specify the
+!-            the positive direction of the axis : up or down.
+!- OUTPUT
+!-
+!- pzaxid   : Returns the ID of the axis.
+!-            Note that this is not the netCDF ID !
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pzsize
+  CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle
+  REAL,INTENT(IN) :: pzvalues(pzsize)
+  INTEGER,INTENT(OUT) :: pzaxid
+  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: pdirect
+!-
+  INTEGER :: pos,iv,zdimid,zaxid_tmp
+  CHARACTER(LEN=70) :: str71
+  CHARACTER(LEN=80) :: str80
+  CHARACTER(LEN=20) :: direction
+  INTEGER :: iret,leng,ncid
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Verifications :
+!    Do we have enough space for an extra axis ?
+!    Is the name already in use ?
+!-
+  IF (l_dbg) WRITE(*,*) "histvert : 1.0 Verifications", &
+ &                      pzaxname,'---',pzaxunit,'---',pzaxtitle
+!-
+! - Direction of axis. Can we get if from the user.
+!   If not we put unknown.
+!-
+  IF (PRESENT(pdirect)) THEN
+    direction = TRIM(pdirect)
+    CALL strlowercase (direction)
+  ELSE
+    direction = 'unknown'
+  ENDIF
+!-
+! Check the consistency of the attribute
+!-
+  IF (     (direction /= 'unknown') &
+ &    .AND.(direction /= 'up')      &
+ &    .AND.(direction /= 'down')   ) THEN
+    direction = 'unknown'
+    str80 = 'The specified axis was : '//TRIM(direction)
+    CALL ipslerr (2,"histvert",&
+   & "The specified direction for the vertical axis is not possible.",&
+   & "it is replaced by : unknown",str80)
+  ENDIF
+!-
+  IF (nb_zax(pfileid)+1 > nb_zax_max) THEN
+    CALL ipslerr (3,"histvert", &
+   &  'Table of vertical axes too small. You should increase ',&
+   &  'nb_zax_max in histcom.f90 in order to accomodate all ', &
+   &  'these variables ')
+  ENDIF
+!-
+  iv = nb_zax(pfileid)
+  IF (iv > 1) THEN
+    CALL find_str (zax_name(pfileid,1:iv-1),pzaxname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    WRITE(str71,'("Check variable ",A," in file",I3)') &
+ &    TRIM(pzaxname),pfileid
+    CALL ipslerr (3,"histvert", &
+ &    "Vertical axis already exists",TRIM(str71), &
+ &    "Can also be a wrong file ID in another declaration")
+  ENDIF
+!-
+  iv = nb_zax(pfileid)+1
+!-
+! 2.0 Add the information to the file
+!-
+  IF (l_dbg) &
+ &  WRITE(*,*) "histvert : 2.0 Add the information to the file"
+!-
+  ncid = ncdf_ids(pfileid)
+!-
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_DEF_DIM (ncid,pzaxname(1:leng),pzsize,zaxid_tmp)
+  iret = NF90_DEF_VAR (ncid,pzaxname(1:leng),NF90_FLOAT, &
+ &                     zaxid_tmp,zdimid)
+  iret = NF90_PUT_ATT (ncid,zdimid,'axis',"Z")
+  iret = NF90_PUT_ATT (ncid,zdimid,'standard_name',"model_level_number")
+  leng = MIN(LEN_TRIM(pzaxunit),20)
+  IF (leng > 0) THEN
+    iret = NF90_PUT_ATT (ncid,zdimid,'units',pzaxunit(1:leng))
+  ENDIF
+  iret = NF90_PUT_ATT (ncid,zdimid,'positive',TRIM(direction))
+  iret = NF90_PUT_ATT (ncid,zdimid,'valid_min', &
+ &                     REAL(MINVAL(pzvalues(1:pzsize)),KIND=4))
+  iret = NF90_PUT_ATT (ncid,zdimid,'valid_max', &
+ &                     REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4))
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_PUT_ATT (ncid,zdimid,'title',pzaxname(1:leng))
+  leng = MIN(LEN_TRIM(pzaxtitle),80)
+  iret = NF90_PUT_ATT (ncid,zdimid,'long_name',pzaxtitle(1:leng))
+!-
+  iret = NF90_ENDDEF (ncid)
+!-
+  iret = NF90_PUT_VAR (ncid,zdimid,pzvalues(1:pzsize))
+!-
+  iret = NF90_REDEF (ncid)
+!-
+!- 3.0 add the information to the common
+!-
+  IF (l_dbg) &
+  &  WRITE(*,*) "histvert : 3.0 add the information to the common"
+!-
+  nb_zax(pfileid) = iv
+  zax_size(pfileid,iv) = pzsize
+  zax_name(pfileid,iv) = pzaxname
+  zax_ids(pfileid,iv) = zaxid_tmp
+  pzaxid =  iv
+!----------------------
+END SUBROUTINE histvert
+!===
+SUBROUTINE histdef (pfileid,pvarname,ptitle,punit, &
+ &                  pxsize,pysize,phoriid,pzsize,  &
+ &                  par_oriz,par_szz,pzid,         &
+ &                  pnbbyt,popp,pfreq_opp,pfreq_wrt,var_range)
+!---------------------------------------------------------------------
+!- With this subroutine each variable to be archived on the history
+!- tape should be declared.
+!-
+!- It gives the user the choise of operation
+!- to be performed on the variables, the frequency of this operation
+!- and finaly the frequency of the archiving.
+!-
+!- INPUT
+!-
+!- pfileid  : ID of the file the variable should be archived in
+!- pvarname : Name of the variable, short and easy to remember
+!- ptitle   : Full name of the variable
+!- punit    : Units of the variable (no units if blank string)
+!-
+!- The next 3 arguments give the size of that data
+!- that will be passed to histwrite. The zoom will be
+!- done there with the horizontal information obtained
+!- in histbeg and the vertical information to follow.
+!-
+!- pxsize   : Size in X direction (size of the data that will be
+!-            given to histwrite)
+!- pysize   : Size in Y direction
+!- phoriid  : ID of the horizontal axis
+!-
+!- The next two arguments give the vertical zoom to use.
+!-
+!- pzsize   : Size in Z direction (If 1 then no axis is declared
+!-            for this variable and pzid is not used)
+!- par_oriz : Off set of the zoom
+!- par_szz  : Size of the zoom
+!-
+!- pzid     : ID of the vertical axis to use. It has to have
+!-            the size of the zoom.
+!- pnbbyt   : Number of bytes on which to store in netCDF (Not opp.)
+!- popp     : Operation to be performed. The following options
+!-            exist today :
+!- inst : keeps instantaneous values for writting
+!- ave  : Computes the average from call between writes
+!- pfreq_opp: Frequency of this operation (in seconds)
+!- pfreq_wrt: Frequency at which the variable should be
+!-            written (in seconds)
+!- var_range: Range of the variable.
+!-            If the minimum is greater than the maximum,
+!-            the values will be calculated.
+!-
+!- VERSION
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pxsize,pysize,pzsize,pzid
+  INTEGER,INTENT(IN) :: par_oriz,par_szz,pnbbyt,phoriid
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle
+  REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt
+  REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range
+!-
+  INTEGER :: iv,i
+  CHARACTER(LEN=70) :: str70,str71,str72
+  CHARACTER(LEN=20) :: tmp_name
+  CHARACTER(LEN=40) :: str40
+  CHARACTER(LEN=10) :: str10
+  CHARACTER(LEN=80) :: tmp_str80
+  CHARACTER(LEN=7) :: tmp_topp,tmp_sopp(nbopp_max)
+  CHARACTER(LEN=120) :: ex_topps
+  REAL :: tmp_scal(nbopp_max),un_an,un_jour,test_fopp,test_fwrt
+  INTEGER :: pos,buff_sz
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'
+!-
+  nb_var(pfileid) = nb_var(pfileid)+1
+  iv = nb_var(pfileid)
+!-
+  IF (iv > nb_var_max) THEN
+    CALL ipslerr (3,"histdef", &
+   &  'Table of variables too small. You should increase nb_var_max',&
+   &  'in histcom.f90 in order to accomodate all these variables', &
+   &  ' ')
+  ENDIF
+!-
+! 1.0 Transfer informations on the variable to the common
+!     and verify that it does not already exist
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 1.0"
+!-
+  IF (iv > 1) THEN
+    CALL find_str (name(pfileid,1:iv-1),pvarname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    str70 = "Variable already exists"
+    WRITE(str71,'("Check variable  ",a," in file",I3)') &
+ &    TRIM(pvarname),pfileid
+    str72 = "Can also be a wrong file ID in another declaration"
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+  name(pfileid,iv) = pvarname
+  title(pfileid,iv) = ptitle
+  unit_name(pfileid,iv) = punit
+  tmp_name =  name(pfileid,iv)
+!-
+! 1.1 decode the operations
+!-
+  fullop(pfileid,iv) = popp
+  tmp_str80 = popp
+  CALL buildop &
+ &  (tmp_str80,ex_topps,tmp_topp,nbopp_max,missing_val, &
+ &   tmp_sopp,tmp_scal,nbopp(pfileid,iv))
+!-
+  topp(pfileid,iv) = tmp_topp
+  DO i=1,nbopp(pfileid,iv)
+    sopps(pfileid,iv,i) = tmp_sopp(i)
+    scal(pfileid,iv,i) = tmp_scal(i)
+  ENDDO
+!-
+! 1.2 If we have an even number of operations
+!     then we need to add identity
+!-
+  IF (2*INT(nbopp(pfileid,iv)/2.0) == nbopp(pfileid,iv)) THEN
+    nbopp(pfileid,iv) = nbopp(pfileid,iv)+1
+    sopps(pfileid,iv,nbopp(pfileid,iv)) = 'ident'
+    scal(pfileid,iv,nbopp(pfileid,iv)) = missing_val
+  ENDIF
+!-
+! 2.0 Put the size of the variable in the common and check
+!-
+  IF (l_dbg) &
+ &  WRITE(*,*) "histdef : 2.0",pfileid,iv,nbopp(pfileid,iv), &
+ &    sopps(pfileid,iv,1:nbopp(pfileid,iv)), &
+ &    scal(pfileid,iv,1:nbopp(pfileid,iv))
+!-
+  scsize(pfileid,iv,1:3) = (/ pxsize,pysize,pzsize /)
+!-
+  zorig(pfileid,iv,1:3) = &
+ &  (/ slab_ori(pfileid,1),slab_ori(pfileid,2),par_oriz /)
+!-
+  zsize(pfileid,iv,1:3) = &
+ &  (/ slab_sz(pfileid,1),slab_sz(pfileid,2),par_szz /)
+!-
+! Is the size of the full array the same as that of the coordinates  ?
+!-
+  IF (    (pxsize > full_size(pfileid,1)) &
+ &    .OR.(pysize > full_size(pfileid,2)) ) THEN
+!-
+    str70 = "The size of the variable is different "// &
+ &          "from the one of the coordinates"
+    WRITE(str71,'("Size of coordinates :",2I4)') &
+ &   full_size(pfileid,1),full_size(pfileid,2)
+    WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! Is the size of the zoom smaler than the coordinates ?
+!-
+  IF (    (full_size(pfileid,1) < slab_sz(pfileid,1)) &
+ &    .OR.(full_size(pfileid,2) < slab_sz(pfileid,2)) ) THEN
+    str70 = &
+ &   "Size of variable should be greater or equal to those of the zoom"
+    WRITE(str71,'("Size of XY zoom :",2I4)') &
+ &   slab_sz(pfileid,1),slab_sz(pfileid,1)
+    WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 2.1 We store the horizontal grid information with minimal
+!     and a fall back onto the default grid
+!-
+  IF ( (phoriid > 0).AND.(phoriid <= nb_hax(pfileid)) ) THEN
+    var_haxid(pfileid,iv) = phoriid
+  ELSE
+    var_haxid(pfileid,iv) = 1
+    CALL ipslerr (2,"histdef", &
+   &  'We use the default grid for variable as an invalide',&
+   &  'ID was provided for variable : ',TRIM(pvarname))
+  ENDIF
+!-
+! 2.2 Check the vertical coordinates if needed
+!-
+  IF (par_szz > 1) THEN
+!-
+!-- Does the vertical coordinate exist ?
+!-
+    IF (pzid > nb_zax(pfileid)) THEN
+      WRITE(str70, &
+ &    '("The vertical coordinate chosen for variable ",a)') &
+ &     TRIM(tmp_name)
+      str71 = " Does not exist."
+      CALL ipslerr (3,"histdef",str70,str71," ")
+    ENDIF
+!-
+!-- Is the vertical size of the variable equal to that of the axis ?
+!-
+    IF (par_szz /= zax_size(pfileid,pzid)) THEN
+      str70 = "The size of the zoom does not correspond "// &
+ &            "to the size of the chosen vertical axis"
+      WRITE(str71,'("Size of zoom in z :",I4)') par_szz
+      WRITE(str72,'("Size declared for axis ",A," :",I4)') &
+ &     TRIM(zax_name(pfileid,pzid)),zax_size(pfileid,pzid)
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+!-
+!-- Is the zoom smaler that the total size of the variable ?
+!-
+    IF (pzsize < par_szz) THEN
+      str70 = "The vertical size of variable "// &
+ &            "is smaller than that of the zoom."
+      WRITE(str71,'("Declared vertical size of data :",I5)') pzsize
+      WRITE(str72,'("Size of zoom for variable ",a," = ",I5)') &
+ &     TRIM(tmp_name),par_szz
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+    var_zaxid(pfileid,iv) = pzid
+  ELSE
+    var_zaxid(pfileid,iv) = -99
+  ENDIF
+!-
+! 3.0 Determine the position of the variable in the buffer
+!     If it is instantaneous output then we do not use the buffer
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 3.0"
+!-
+! 3.1 We get the size of the arrays histwrite will get and check
+!     that they fit into the tmp_buffer
+!-
+  buff_sz = zsize(pfileid,iv,1)*zsize(pfileid,iv,2)*zsize(pfileid,iv,3)
+!-
+! 3.2 move the pointer of the buffer array for operation
+!     which need bufferisation
+!-
+  IF (     (TRIM(tmp_topp) /= "inst") &
+ &    .AND.(TRIM(tmp_topp) /= "once") &
+ &    .AND.(TRIM(tmp_topp) /= "never") )THEN
+    point(pfileid,iv) = buff_pos+1
+    buff_pos = buff_pos+buff_sz
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 3.2 bufpos for iv = ",iv, &
+ &               " pfileid = ",pfileid," is = ",point(pfileid,iv)
+    ENDIF
+  ENDIF
+!-
+! 4.0 Transfer the frequency of the operations and check
+!     for validity. We have to pay attention to negative values
+!     of the frequency which indicate monthly time-steps.
+!     The strategy is to bring it back to seconds for the tests
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 4.0"
+!-
+  freq_opp(pfileid,iv) = pfreq_opp
+  freq_wrt(pfileid,iv) = pfreq_wrt
+!-
+  CALL ioget_calendar(un_an,un_jour)
+  IF (pfreq_opp < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fopp = pfreq_opp
+  ENDIF
+  IF (pfreq_wrt < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fwrt = pfreq_wrt
+  ENDIF
+!-
+! 4.1 Frequency of operations and output should be larger than deltat !
+!-
+  IF (test_fopp < deltat(pfileid)) THEN
+    str70 = 'Frequency of operations should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_opp
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    freq_opp(pfileid,iv) = deltat(pfileid)
+  ENDIF
+!-
+  IF (test_fwrt < deltat(pfileid)) THEN
+    str70 = 'Frequency of output should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_wrt
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    freq_wrt(pfileid,iv) = deltat(pfileid)
+  ENDIF
+!-
+! 4.2 First the existence of the operation is tested and then
+!     its compaticility with the choice of frequencies
+!-
+  IF (TRIM(tmp_topp) == "inst") THEN
+    IF (test_fopp /= test_fwrt) THEN
+      str70 = 'For instantaneous output the frequency '// &
+ &            'of operations and output'
+      WRITE(str71, &
+ &     '("should be the same, this was not case for variable ",a)') &
+ &      TRIM(tmp_name)
+      str72 = "PATCH : The smalest frequency of both is used"
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      IF (test_fopp < test_fwrt) THEN
+        freq_opp(pfileid,iv) = pfreq_opp
+        freq_wrt(pfileid,iv) = pfreq_opp
+      ELSE
+        freq_opp(pfileid,iv) = pfreq_wrt
+        freq_wrt(pfileid,iv) = pfreq_wrt
+      ENDIF
+    ENDIF
+  ELSE IF (INDEX(ex_topps,TRIM(tmp_topp)) > 0) THEN
+    IF (test_fopp > test_fwrt) THEN
+      str70 = 'For averages the frequency of operations '// &
+&             'should be smaller or equal'
+      WRITE(str71, &
+ &     '("to that of output. It is not the case for variable ",a)') &
+ &     TRIM(tmp_name)
+      str72 = 'PATCH : The output frequency is used for both'
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      freq_opp(pfileid,iv) = pfreq_wrt
+    ENDIF
+  ELSE
+    WRITE (str70,'("Operation on variable ",a," is unknown")') &
+&    TRIM(tmp_name)
+    WRITE (str71,'("operation requested is :",a)') tmp_topp
+    WRITE (str72,'("File ID :",I3)') pfileid
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 5.0 Initialize other variables of the common
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 5.0"
+!-
+  hist_wrt_rng(pfileid,iv) = (PRESENT(var_range))
+  IF (hist_wrt_rng(pfileid,iv)) THEN
+    hist_calc_rng(pfileid,iv) = (var_range(1) > var_range(2))
+    IF (hist_calc_rng(pfileid,iv)) THEN
+      hist_minmax(pfileid,iv,1:2) = &
+ &      (/ ABS(missing_val),-ABS(missing_val) /)
+    ELSE
+      hist_minmax(pfileid,iv,1:2) = var_range(1:2)
+    ENDIF
+  ENDIF
+!-
+! - freq_opp(pfileid,iv)/2./deltat(pfileid)
+  last_opp(pfileid,iv) = itau0(pfileid)
+! - freq_wrt(pfileid,iv)/2./deltat(pfileid)
+  last_wrt(pfileid,iv) = itau0(pfileid)
+! - freq_opp(pfileid,iv)/2./deltat(pfileid)
+  last_opp_chk(pfileid,iv) = itau0(pfileid)
+! - freq_wrt(pfileid,iv)/2./deltat(pfileid)
+  last_wrt_chk(pfileid,iv) = itau0(pfileid)
+  nb_opp(pfileid,iv) = 0
+  nb_wrt(pfileid,iv) = 0
+!-
+! 6.0 Get the time axis for this variable
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 6.0"
+!-
+  IF (freq_wrt(pfileid,iv) > 0) THEN
+    WRITE(str10,'(I8.8)') INT(freq_wrt(pfileid,iv))
+    str40 = TRIM(tmp_topp)//"_"//TRIM(str10)
+  ELSE
+    WRITE(str10,'(I2.2,"month")') ABS(INT(freq_wrt(pfileid,iv)))
+    str40 = TRIM(tmp_topp)//"_"//TRIM(str10)
+  ENDIF
+  CALL find_str (tax_name(pfileid,1:nb_tax(pfileid)),str40,pos)
+!-
+! No time axis for once, l_max, l_min or never operation
+!-
+  IF (     (TRIM(tmp_topp) /= 'once')  &
+ &    .AND.(TRIM(tmp_topp) /= 'never') &
+ &    .AND.(TRIM(tmp_topp) /= 'l_max') &
+ &    .AND.(TRIM(tmp_topp) /= 'l_min') ) THEN
+    IF (pos < 0) THEN
+      nb_tax(pfileid) = nb_tax(pfileid)+1
+      tax_name(pfileid,nb_tax(pfileid)) = str40
+      tax_last(pfileid,nb_tax(pfileid)) = 0
+      var_axid(pfileid,iv) = nb_tax(pfileid)
+    ELSE
+      var_axid(pfileid,iv) = pos
+    ENDIF
+  ELSE
+    IF (l_dbg)   WRITE(*,*) "histdef : 7.0 ",TRIM(tmp_topp),'----'
+    var_axid(pfileid,iv) = -99
+  ENDIF
+!-
+! 7.0 prepare frequence of writing and operation
+!     for never or once operation
+!-
+  IF (    (TRIM(tmp_topp) == 'once')  &
+ &    .OR.(TRIM(tmp_topp) == 'never') ) THEN
+    freq_opp(pfileid,iv) = 0.
+    freq_wrt(pfileid,iv) = 0.
+  ENDIF
+!---------------------
+END SUBROUTINE histdef
+!===
+SUBROUTINE histend (pfileid)
+!---------------------------------------------------------------------
+!- This subroutine end the decalaration of variables and sets the
+!- time axes in the netcdf file and puts it into the write mode.
+!-
+!- INPUT
+!-
+!- pfileid : ID of the file to be worked on
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid
+!-
+  INTEGER :: ncid,ncvarid,iret,ndim,iv,itx,ziv,itax,dim_cnt
+  INTEGER,DIMENSION(4) :: dims
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  REAL :: rtime0
+  CHARACTER(LEN=30) :: str30
+  CHARACTER(LEN=120) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=3),DIMENSION(12) :: cal =   &
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  CHARACTER(LEN=7) :: tmp_opp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ncid = ncdf_ids(pfileid)
+!-
+! 1.0 Create the time axes
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 1.0"
+!---
+  iret = NF90_DEF_DIM (ncid,'time_counter',NF90_UNLIMITED,tid(pfileid))
+!-
+! 1.1 Define all the time axes needed for this file
+!-
+  DO itx=1,nb_tax(pfileid)
+    dims(1) = tid(pfileid)
+    IF (nb_tax(pfileid) > 1) THEN
+      str30 = "t_"//tax_name(pfileid,itx)
+    ELSE
+      str30 = "time_counter"
+    ENDIF
+    iret = NF90_DEF_VAR (ncid,str30,NF90_DOUBLE, &
+ &                       dims(1),tdimid(pfileid,itx))
+    IF (nb_tax(pfileid) <= 1) THEN
+      iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'axis',"T")
+    ENDIF
+    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'standard_name',"time")
+!---
+!   To transform the current itau into a real date and take it
+!   as the origin of the file requires the time counter to change.
+!   Thus it is an operation the user has to ask for.
+!   This function should thus only be re-instated
+!   if there is a ioconf routine to control it.
+!---
+!-- rtime0 = itau2date(itau0(pfileid),date0(pfileid),deltat(pfileid))
+    rtime0 = date0(pfileid)
+!-
+    CALL ju2ymds(rtime0,year,month,day,sec)
+!---
+!   Catch any error induced by a change in calendar !
+!---
+    IF (year < 0) THEN
+      year = 2000+year
+    ENDIF
+!-
+    hours = INT(sec/(60.*60.))
+    minutes = INT((sec-hours*60.*60.)/60.)
+    sec = sec-(hours*60.*60.+minutes*60.)
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    'seconds since ',year,month,day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'units',TRIM(str70))
+!-
+    CALL ioget_calendar (str30)
+    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), &
+ &                       'calendar',TRIM(str30))
+!-
+    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'title','Time')
+!-
+    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), &
+ &                       'long_name','Time axis')
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    year,cal(month),day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), &
+ &                       'time_origin',TRIM(str70))
+  ENDDO
+!-
+! 2.0 declare the variables
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 2.0"
+!-
+  DO iv=1,nb_var(pfileid)
+!---
+    itax = var_axid(pfileid,iv)
+!---
+    IF (regular(pfileid) ) THEN
+      dims(1:2) = (/ xid(pfileid),yid(pfileid) /)
+      dim_cnt = 2
+    ELSE
+      dims(1) = xid(pfileid)
+      dim_cnt = 1
+    ENDIF
+!---
+    tmp_opp = topp(pfileid,iv)
+    ziv = var_zaxid(pfileid,iv)
+!---
+!   2.1 dimension of field
+!---
+    IF ((TRIM(tmp_opp) /= 'never')) THEN
+      IF (     (TRIM(tmp_opp) /= 'once')  &
+     &    .AND.(TRIM(tmp_opp) /= 'l_max') &
+     &    .AND.(TRIM(tmp_opp) /= 'l_min') ) THEN
+        IF (ziv == -99) THEN
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ tid(pfileid),0 /)
+        ELSE
+          ndim = dim_cnt+2
+          dims(dim_cnt+1:dim_cnt+2) = (/zax_ids(pfileid,ziv),tid(pfileid)/)
+        ENDIF
+      ELSE
+        IF (ziv == -99) THEN
+          ndim = dim_cnt
+          dims(dim_cnt+1:dim_cnt+2) = (/ 0,0 /)
+        ELSE
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv),0 /)
+        ENDIF
+      ENDIF
+!-
+      iret = NF90_DEF_VAR (ncid,TRIM(name(pfileid,iv)),NF90_FLOAT, &
+ &                         dims(1:ABS(ndim)),ncvarid)
+!-
+      ncvar_ids(pfileid,iv) = ncvarid
+!-
+      IF (LEN_TRIM(unit_name(pfileid,iv)) > 0) THEN
+        iret = NF90_PUT_ATT (ncid,ncvarid,'units', &
+ &                           TRIM(unit_name(pfileid,iv)))
+      ENDIF
+      iret = NF90_PUT_ATT (ncid,ncvarid,'standard_name', &
+ &                         TRIM(title(pfileid,iv)))
+!-
+      iret = NF90_PUT_ATT (ncid,ncvarid,'_Fillvalue', &
+ &                         REAL(missing_val,KIND=4))
+      IF (hist_wrt_rng(pfileid,iv)) THEN
+        iret = NF90_PUT_ATT (ncid,ncvarid,'valid_min', &
+ &                           REAL(hist_minmax(pfileid,iv,1),KIND=4))
+        iret = NF90_PUT_ATT (ncid,ncvarid,'valid_max', &
+ &                           REAL(hist_minmax(pfileid,iv,2),KIND=4))
+      ENDIF
+      iret = NF90_PUT_ATT (ncid,ncvarid,'long_name', &
+ &                         TRIM(title(pfileid,iv)))
+      iret = NF90_PUT_ATT (ncid,ncvarid,'online_operation', &
+ &                         TRIM(fullop(pfileid,iv)))
+!-
+      SELECT CASE(ndim)
+      CASE(-3,2:4)
+      CASE DEFAULT
+        CALL ipslerr (3,"histend", &
+       &  'less than 2 or more than 4 dimensions are not', &
+       &  'allowed at this stage',' ')
+      END SELECT
+!-
+      assoc=TRIM(hax_name(pfileid,var_haxid(pfileid,iv),2))  &
+ &   //' '//TRIM(hax_name(pfileid,var_haxid(pfileid,iv),1))
+!-
+      ziv = var_zaxid(pfileid,iv)
+      IF (ziv > 0) THEN
+        str30 = zax_name(pfileid,ziv)
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+      ENDIF
+!-
+      IF (itax > 0) THEN
+        IF (nb_tax(pfileid) > 1) THEN
+          str30 = "t_"//tax_name(pfileid,itax)
+        ELSE
+          str30 = "time_counter"
+        ENDIF
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+!-
+        IF (l_dbg) THEN
+          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", &
+ &                   freq_opp(pfileid,iv),freq_wrt(pfileid,iv)
+        ENDIF
+!-
+        iret = NF90_PUT_ATT (ncid,ncvarid,'interval_operation', &
+ &                           REAL(freq_opp(pfileid,iv),KIND=4))
+        iret = NF90_PUT_ATT (ncid,ncvarid,'interval_write', &
+ &                           REAL(freq_wrt(pfileid,iv),KIND=4))
+      ENDIF
+      iret = NF90_PUT_ATT (ncid,ncvarid,'coordinates',TRIM(assoc))
+    ENDIF
+  ENDDO
+!-
+! 2.2 Add DOMAIN attributes if needed
+!-
+  IF (dom_id_svg(pfileid) >= 0) THEN
+    CALL flio_dom_att (ncid,dom_id_svg(pfileid))
+  ENDIF
+!-
+! 3.0 Put the netcdf file into write mode
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 3.0"
+!-
+  iret = NF90_ENDDEF (ncid)
+!-
+! 4.0 Give some informations to the user
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 4.0"
+!-
+  WRITE(str70,'("All variables have been initialized on file :",I3)') pfileid
+  CALL ipslerr (1,'histend',str70,'',' ')
+!---------------------
+END SUBROUTINE histend
+!===
+SUBROUTINE histwrite_r1d (pfileid,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_1d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r1d
+!===
+SUBROUTINE histwrite_r2d (pfileid,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_2d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r2d
+!===
+SUBROUTINE histwrite_r3d (pfileid,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_3d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r3d
+!===
+SUBROUTINE histw_rnd (pfileid,pvarname,pitau,nbindex,nindex, &
+  &                   pdata_1d,pdata_2d,pdata_3d)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL     :: pdata_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL   :: pdata_2d
+  REAL,DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: pdata_3d
+!-
+  LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d
+  INTEGER :: varid,io,nbpt_out
+  INTEGER              :: nbpt_in1
+  INTEGER,DIMENSION(2) :: nbpt_in2
+  INTEGER,DIMENSION(3) :: nbpt_in3
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp
+  INTEGER,SAVE :: buff_tmp_sz
+  CHARACTER(LEN=7) :: tmp_opp
+  CHARACTER(LEN=13) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  l1d=PRESENT(pdata_1d); l2d=PRESENT(pdata_2d); l3d=PRESENT(pdata_3d);
+  IF      (l1d) THEN
+    c_nam = 'histwrite_r1d'
+  ELSE IF (l2d) THEN
+    c_nam = 'histwrite_r2d'
+  ELSE IF (l3d) THEN
+    c_nam = 'histwrite_r3d'
+  ENDIF
+!-
+! 1.0 Try to catch errors like specifying the wrong file ID.
+!     Thanks Marine for showing us what errors users can make !
+!-
+  IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'Illegal file ID in the histwrite of variable',pvarname,' ')
+  ENDIF
+!-
+! 1.1 Find the id of the variable to be written and the real time
+!-
+  CALL histvar_seq (pfileid,pvarname,varid)
+!-
+! 2.0 do nothing for never operation
+!-
+  tmp_opp = topp(pfileid,varid)
+!-
+  IF (TRIM(tmp_opp) == "never") THEN
+    last_opp_chk(pfileid,varid) = -99
+    last_wrt_chk(pfileid,varid) = -99
+  ENDIF
+!-
+! 3.0 We check if we need to do an operation
+!-
+  IF (last_opp_chk(pfileid,varid) == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable has already been analysed at the present', &
+ &    'time step',TRIM(pvarname))
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,date0(pfileid),deltat(pfileid),freq_opp(pfileid,varid), &
+ &   last_opp(pfileid,varid),last_opp_chk(pfileid,varid),do_oper)
+!-
+! 4.0 We check if we need to write the data
+!-
+  IF (last_wrt_chk(pfileid,varid) == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable has already been written for the present', &
+ &    'time step',TRIM(pvarname))
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,date0(pfileid),deltat(pfileid),freq_wrt(pfileid,varid), &
+ &   last_wrt(pfileid,varid),last_wrt_chk(pfileid,varid),do_write)
+!-
+! 5.0 histwrite called
+!-
+  IF (do_oper.OR.do_write) THEN
+!-
+!-- 5.1 Get the sizes of the data we will handle
+!-
+    IF (datasz_in(pfileid,varid,1) <= 0) THEN
+!---- There is the risk here that the user has over-sized the array.
+!---- But how can we catch this ?
+!---- In the worst case we will do impossible operations
+!---- on part of the data !
+      datasz_in(pfileid,varid,1:3) = -1
+      IF      (l1d) THEN
+        datasz_in(pfileid,varid,1) = SIZE(pdata_1d)
+      ELSE IF (l2d) THEN
+        datasz_in(pfileid,varid,1) = SIZE(pdata_2d,DIM=1)
+        datasz_in(pfileid,varid,2) = SIZE(pdata_2d,DIM=2)
+      ELSE IF (l3d) THEN
+        datasz_in(pfileid,varid,1) = SIZE(pdata_3d,DIM=1)
+        datasz_in(pfileid,varid,2) = SIZE(pdata_3d,DIM=2)
+        datasz_in(pfileid,varid,3) = SIZE(pdata_3d,DIM=3)
+      ENDIF
+    ENDIF
+!-
+!-- 5.2 The maximum size of the data will give the size of the buffer
+!-
+    IF (datasz_max(pfileid,varid) <= 0) THEN
+      largebuf = .FALSE.
+      DO io=1,nbopp(pfileid,varid)
+        IF (INDEX(fuchnbout,sopps(pfileid,varid,io)) > 0) THEN
+          largebuf = .TRUE.
+        ENDIF
+      ENDDO
+      IF (largebuf) THEN
+        datasz_max(pfileid,varid) = &
+ &        scsize(pfileid,varid,1) &
+ &       *scsize(pfileid,varid,2) &
+ &       *scsize(pfileid,varid,3)
+      ELSE
+        IF      (l1d) THEN
+          datasz_max(pfileid,varid) = &
+ &          datasz_in(pfileid,varid,1)
+        ELSE IF (l2d) THEN
+          datasz_max(pfileid,varid) = &
+ &          datasz_in(pfileid,varid,1) &
+ &         *datasz_in(pfileid,varid,2)
+        ELSE IF (l3d) THEN
+          datasz_max(pfileid,varid) = &
+ &          datasz_in(pfileid,varid,1) &
+ &         *datasz_in(pfileid,varid,2) &
+ &         *datasz_in(pfileid,varid,3)
+        ENDIF
+      ENDIF
+    ENDIF
+!-
+    IF (.NOT.ALLOCATED(buff_tmp)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : allocate buff_tmp for buff_sz = ", &
+ &       datasz_max(pfileid,varid)
+      ENDIF
+      ALLOCATE(buff_tmp(datasz_max(pfileid,varid)))
+      buff_tmp_sz = datasz_max(pfileid,varid)
+    ELSE IF (datasz_max(pfileid,varid) > buff_tmp_sz) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : re-allocate buff_tmp for buff_sz = ", &
+ &       datasz_max(pfileid,varid)
+      ENDIF
+      DEALLOCATE(buff_tmp)
+      ALLOCATE(buff_tmp(datasz_max(pfileid,varid)))
+      buff_tmp_sz = datasz_max(pfileid,varid)
+    ENDIF
+!-
+!-- We have to do the first operation anyway.
+!-- Thus we do it here and change the ranke
+!-- of the data at the same time. This should speed up things.
+!-
+    nbpt_out = datasz_max(pfileid,varid)
+    IF      (l1d) THEN
+      nbpt_in1 = datasz_in(pfileid,varid,1)
+      CALL mathop (sopps(pfileid,varid,1),nbpt_in1,pdata_1d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 scal(pfileid,varid,1),nbpt_out,buff_tmp)
+    ELSE IF (l2d) THEN
+      nbpt_in2(1:2) = datasz_in(pfileid,varid,1:2)
+      CALL mathop (sopps(pfileid,varid,1),nbpt_in2,pdata_2d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 scal(pfileid,varid,1),nbpt_out,buff_tmp)
+    ELSE IF (l3d) THEN
+      nbpt_in3(1:3) = datasz_in(pfileid,varid,1:3)
+      CALL mathop (sopps(pfileid,varid,1),nbpt_in3,pdata_3d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 scal(pfileid,varid,1),nbpt_out,buff_tmp)
+    ENDIF
+    CALL histwrite_real (pfileid,varid,pitau,nbpt_out, &
+ &            buff_tmp,nbindex,nindex,do_oper,do_write)
+  ENDIF
+!-
+! 6.0 Manage time steps
+!-
+  IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
+    last_opp_chk(pfileid,varid) = pitau
+    last_wrt_chk(pfileid,varid) = pitau
+  ELSE
+    last_opp_chk(pfileid,varid) = -99
+    last_wrt_chk(pfileid,varid) = -99
+  ENDIF
+!-----------------------
+END SUBROUTINE histw_rnd
+!===
+SUBROUTINE histwrite_real &
+ & (pfileid,varid,pitau,nbdpt,buff_tmp,nbindex,nindex,do_oper,do_write)
+!---------------------------------------------------------------------
+!- This subroutine is internal and does the calculations and writing
+!- if needed. At a later stage it should be split into an operation
+!- and writing subroutines.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: pfileid,pitau,varid, &
+ &                      nbindex,nindex(nbindex),nbdpt
+  REAL,DIMENSION(:)  :: buff_tmp
+  LOGICAL,INTENT(IN) :: do_oper,do_write
+!-
+  INTEGER :: tsz,ncid,ncvarid,i,iret,ipt,itax,io,nbin,nbout
+  INTEGER :: nx,ny,nz,ky,kz,kt,kc
+  INTEGER,DIMENSION(4) :: corner,edges
+  INTEGER :: itime
+!-
+  REAL :: rtime
+  CHARACTER(LEN=7) :: tmp_opp
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp2,buffer_used
+  INTEGER,SAVE :: buff_tmp2_sz,buffer_sz
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite 0.0 : VAR : ",name(pfileid,varid)
+    WRITE(*,*) "histwrite 0.0 : nbindex,nindex :", &
+ &  nbindex,nindex(1:MIN(3,nbindex)),'...',nindex(MAX(1,nbindex-3):nbindex)
+  ENDIF
+!-
+! The sizes which can be encoutered
+!-
+  tsz =  zsize(pfileid,varid,1) &
+ &      *zsize(pfileid,varid,2) &
+ &      *zsize(pfileid,varid,3)
+!-
+! 1.0 We allocate the memory needed to store the data between write
+!     and the temporary space needed for operations.
+!     We have to keep precedent buffer if needed
+!-
+  IF (.NOT. ALLOCATED(buffer)) THEN
+    IF (l_dbg) WRITE(*,*) "histwrite_real 1.0 allocate buffer ",buff_pos
+    ALLOCATE(buffer(buff_pos))
+    buffer_sz = buff_pos
+    buffer(:)=0.0
+  ELSE IF (buffer_sz < buff_pos) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.0.1 re-allocate buffer for ", &
+ &      buff_pos," instead of ",SIZE(buffer)
+    ENDIF
+    IF (SUM(buffer)/=0.0) THEN
+      IF (l_dbg) WRITE (*,*) 'histwrite : buffer has been used. ', &
+ &      'We have to save it before re-allocating.'
+      ALLOCATE(buffer_used(buffer_sz))
+      buffer_used(:)=buffer(:)
+      DEALLOCATE(buffer)
+      ALLOCATE(buffer(buff_pos))
+      buffer_sz = buff_pos
+      buffer(:)=0.0
+      buffer(:SIZE(buffer_used))=buffer_used
+      DEALLOCATE(buffer_used)
+    ELSE
+      IF (l_dbg) WRITE (*,*) 'histwrite : buffer has not been used. ', &
+ &      'We have just to re-allocate it.'
+      DEALLOCATE(buffer)
+      ALLOCATE(buffer(buff_pos))
+      buffer_sz = buff_pos
+      buffer(:)=0.0
+    ENDIF
+  ENDIF
+!-
+! The buffers are only deallocated when more space is needed. This
+! reduces the umber of allocates but increases memory needs.
+!-
+  IF (.NOT.ALLOCATED(buff_tmp2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.1 allocate buff_tmp2 ",SIZE(buff_tmp)
+    ENDIF
+    ALLOCATE(buff_tmp2(datasz_max(pfileid,varid)))
+    buff_tmp2_sz = datasz_max(pfileid,varid)
+  ELSE IF (datasz_max(pfileid,varid) > buff_tmp2_sz) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.2 re-allocate buff_tmp2 : ", &
+     & SIZE(buff_tmp)," instead of ",SIZE(buff_tmp2)
+    ENDIF
+    DEALLOCATE(buff_tmp2)
+    ALLOCATE(buff_tmp2(datasz_max(pfileid,varid)))
+    buff_tmp2_sz = datasz_max(pfileid,varid)
+  ENDIF
+!-
+  rtime = pitau * deltat(pfileid)
+  tmp_opp = topp(pfileid,varid)
+!-
+! 3.0 Do the operations or transfer the slab of data into buff_tmp
+!-
+  IF (l_dbg) WRITE(*,*) "histwrite: 3.0",pfileid
+!-
+! 3.1 DO the Operations only if needed
+!-
+  IF (do_oper) THEN
+    i = pfileid
+    nbout = nbdpt
+!-
+!-- 3.4 We continue the sequence of operations
+!--     we started in the interface routine
+!-
+    DO io = 2,nbopp(i,varid),2
+      nbin = nbout
+      nbout = datasz_max(i,varid)
+      CALL mathop(sopps(i,varid,io),nbin,buff_tmp,missing_val, &
+ &      nbindex,nindex,scal(i,varid,io),nbout,buff_tmp2)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       "histwrite: 3.4a nbout : ",nbin,nbout,sopps(i,varid,io)
+      ENDIF
+!-
+      nbin = nbout
+      nbout = datasz_max(i,varid)
+      CALL mathop(sopps(i,varid,io+1),nbin,buff_tmp2,missing_val, &
+ &      nbindex,nindex,scal(i,varid,io+1),nbout,buff_tmp)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       "histwrite: 3.4b nbout : ",nbin,nbout,sopps(i,varid,io+1)
+      ENDIF
+    ENDDO
+!-
+!   3.5 Zoom into the data
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+ &     "histwrite: 3.5 size(buff_tmp) : ",SIZE(buff_tmp)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in X :",zorig(i,varid,1),zsize(i,varid,1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Y :",zorig(i,varid,2),zsize(i,varid,2)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Z :",zorig(i,varid,3),zsize(i,varid,3)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab of input:", &
+ &     scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3)
+    ENDIF
+!---
+!-- We have to consider blocks of contiguous data
+!---
+    nx=MAX(zsize(i,varid,1),1)
+    ny=MAX(zsize(i,varid,2),1)
+    nz=MAX(zsize(i,varid,3),1)
+    IF     (     (zorig(i,varid,1) == 1) &
+   &        .AND.(zsize(i,varid,1) == scsize(i,varid,1)) &
+   &        .AND.(zorig(i,varid,2) == 1) &
+   &        .AND.(zsize(i,varid,2) == scsize(i,varid,2))) THEN
+      kt = (zorig(i,varid,3)-1)*nx*ny
+      buff_tmp2(1:nx*ny*nz) = buff_tmp(kt+1:kt+nx*ny*nz)
+    ELSEIF (     (zorig(i,varid,1) == 1) &
+   &        .AND.(zsize(i,varid,1) == scsize(i,varid,1))) THEN
+      kc = -nx*ny
+      DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz-1
+        kc = kc+nx*ny
+        kt = ((kz-1)*scsize(i,varid,2)+zorig(i,varid,2)-1)*nx
+        buff_tmp2(kc+1:kc+nx*ny) = buff_tmp(kt+1:kt+nx*ny)
+      ENDDO
+    ELSE
+      kc = -nx
+      DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz-1
+        DO ky=zorig(i,varid,2),zorig(i,varid,2)+ny-1
+          kc = kc+nx
+          kt = ((kz-1)*scsize(i,varid,2)+ky-1)*scsize(i,varid,1) &
+   &          +zorig(i,varid,1)-1
+          buff_tmp2(kc+1:kc+nx) = buff_tmp(kt+1:kt+nx)
+        ENDDO
+      ENDDO
+    ENDIF
+!-
+!-- 4.0 Get the min and max of the field (buff_tmp)
+!-
+    IF (l_dbg) WRITE(*,*) "histwrite: 4.0 buff_tmp",pfileid,varid, &
+ &    TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
+!-
+    IF (hist_calc_rng(pfileid,varid)) THEN
+      hist_minmax(pfileid,varid,1) = &
+ &      MIN(hist_minmax(pfileid,varid,1), &
+ &      MINVAL(buff_tmp2(1:tsz),MASK=buff_tmp2(1:tsz) /= missing_val))
+      hist_minmax(pfileid,varid,2) = &
+ &      MAX(hist_minmax(pfileid,varid,2), &
+ &      MAXVAL(buff_tmp2(1:tsz),MASK=buff_tmp2(1:tsz) /= missing_val))
+    ENDIF
+!-
+!-- 5.0 Do the operations if needed. In the case of instantaneous
+!--     output we do not transfer to the buffer.
+!-
+    IF (l_dbg) WRITE(*,*) "histwrite: 5.0",pfileid,"tsz :",tsz
+!-
+    ipt = point(pfileid,varid)
+!-
+!   WRITE(*,*) 'OPE ipt, buffer :',pvarname,ipt,varid
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      CALL moycum(tmp_opp,tsz,buffer(ipt:), &
+     &       buff_tmp2,nb_opp(pfileid,varid))
+    ENDIF
+!-
+    last_opp(pfileid,varid) = pitau
+    nb_opp(pfileid,varid) = nb_opp(pfileid,varid)+1
+!-
+  ENDIF
+!-
+! 6.0 Write to file if needed
+!-
+  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",pfileid
+!-
+  IF (do_write) THEN
+!-
+    ncvarid = ncvar_ids(pfileid,varid)
+    ncid = ncdf_ids(pfileid)
+!-
+!-- 6.1 Do the operations that are needed before writting
+!-
+    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",pfileid
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      rtime = (rtime+last_wrt(pfileid,varid)*deltat(pfileid))/2.0
+    ENDIF
+!-
+!-- 6.2 Add a value to the time axis of this variable if needed
+!-
+    IF (     (TRIM(tmp_opp) /= "l_max") &
+   &    .AND.(TRIM(tmp_opp) /= "l_min") &
+   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
+!-
+      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",pfileid
+!-
+      itax = var_axid(pfileid,varid)
+      itime = nb_wrt(pfileid,varid)+1
+!-
+      IF (tax_last(pfileid,itax) < itime) THEN
+        iret = NF90_PUT_VAR (ncid,tdimid(pfileid,itax),(/ rtime /), &
+ &                            start=(/ itime /),count=(/ 1 /))
+        tax_last(pfileid,itax) = itime
+      ENDIF
+    ELSE
+      itime=1
+    ENDIF
+!-
+!-- 6.3 Write the data. Only in the case of instantaneous output
+!       we do not write the buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 6.3",pfileid,ncid,ncvarid,varid,itime
+    ENDIF
+!-
+    IF (scsize(pfileid,varid,3) == 1) THEN
+      IF (regular(pfileid)) THEN
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ zsize(pfileid,varid,1), &
+ &                      zsize(pfileid,varid,2),1,0 /)
+      ELSE
+        corner(1:4) = (/ 1,itime,0,0 /)
+        edges(1:4) = (/ zsize(pfileid,varid,1),1,0,0 /)
+      ENDIF
+    ELSE
+      IF (regular(pfileid)) THEN
+        corner(1:4) = (/ 1,1,1,itime /)
+        edges(1:4) = (/ zsize(pfileid,varid,1), &
+ &                      zsize(pfileid,varid,2), &
+ &                      zsize(pfileid,varid,3),1 /)
+      ELSE
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ zsize(pfileid,varid,1), &
+ &                      zsize(pfileid,varid,3),1,0 /)
+      ENDIF
+    ENDIF
+!-
+    ipt = point(pfileid,varid)
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      iret = NF90_PUT_VAR (ncid,ncvarid,buffer(ipt:), &
+ &                       start=corner(1:4),count=edges(1:4))
+    ELSE
+      iret = NF90_PUT_VAR (ncid,ncvarid,buff_tmp2, &
+ &                       start=corner(1:4),count=edges(1:4))
+    ENDIF
+!-
+    last_wrt(pfileid,varid) = pitau
+    nb_wrt(pfileid,varid) = nb_wrt(pfileid,varid)+1
+    nb_opp(pfileid,varid) = 0
+!---
+!   After the write the file can be synchronized so that no data is
+!   lost in case of a crash. This feature gives up on the benefits of
+!   buffering and should only be used in debuging mode. A flag is
+!   needed here to switch to this mode.
+!---
+!   iret = NF90_SYNC (ncid)
+!-
+  ENDIF
+!----------------------------
+END SUBROUTINE histwrite_real
+!===
+SUBROUTINE histvar_seq (pfid,pvarname,pvid)
+!---------------------------------------------------------------------
+!- This subroutine optimized the search for the variable in the table.
+!- In a first phase it will learn the succession of the variables
+!- called and then it will use the table to guess what comes next.
+!- It is the best solution to avoid lengthy searches through array
+!- vectors.
+!-
+!- ARGUMENTS :
+!-
+!- pfid  : id of the file on which we work
+!- pvarname : The name of the variable we are looking for
+!- pvid     : The var id we found
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in)  :: pfid
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  INTEGER,INTENT(out) :: pvid
+!-
+  LOGICAL,SAVE :: learning(nb_files_max)=.TRUE.
+  INTEGER,SAVE :: overlap(nb_files_max) = -1
+  INTEGER,SAVE :: varseq(nb_files_max,nb_var_max*3)
+  INTEGER,SAVE :: varseq_len(nb_files_max) = 0
+  INTEGER,SAVE :: varseq_pos(nb_files_max)
+  INTEGER,SAVE :: varseq_err(nb_files_max) = 0
+  INTEGER      :: ib,sp,nn,pos
+  CHARACTER(LEN=70) :: str70
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(pfid)
+  ENDIF
+!-
+  IF (learning(pfid)) THEN
+!-
+!-- 1.0 We compute the length over which we are going
+!--     to check the overlap
+!-
+    IF (overlap(pfid) <= 0) THEN
+      IF (nb_var(pfid) > 6) THEN
+        overlap(pfid) = nb_var(pfid)/3*2
+      ELSE
+        overlap(pfid) = nb_var(pfid)
+      ENDIF
+    ENDIF
+!-
+!-- 1.1 Find the position of this string
+!-
+    CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos)
+    IF (pos > 0) THEN
+      pvid = pos
+    ELSE
+      CALL ipslerr (3,"histvar_seq", &
+ &      'The name of the variable you gave has not been declared', &
+ &      'You should use subroutine histdef for declaring variable', &
+ &      TRIM(pvarname))
+    ENDIF
+!-
+!-- 1.2 If we have not given up we store the position
+!--     in the sequence of calls
+!-
+    IF (varseq_err(pfid) >= 0) THEN
+      sp = varseq_len(pfid)+1
+      IF (sp <= nb_var_max*3) THEN
+        varseq(pfid,sp) = pvid
+        varseq_len(pfid) = sp
+      ELSE
+        CALL ipslerr (2,"histvar_seq",&
+ &       'The learning process has failed and we give up. '// &
+ &       'Either you sequence is',&
+ &       'too complex or I am too dumb. '// &
+ &       'This will only affect the efficiency',&
+ &       'of your code. Thus if you wish to save time'// &
+ &       ' contact the IOIPSL team. ')
+        WRITE(*,*) 'The sequence we have found up to now :'
+        WRITE(*,*) varseq(pfid,1:sp-1)
+        varseq_err(pfid) = -1
+      ENDIF
+!-
+!---- 1.3 Check if we have found the right overlap
+!-
+      IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN
+!-
+!------ We skip a few variables if needed as they could come
+!------ from the initialisation of the model.
+!-
+        DO ib = 0,sp-overlap(pfid)*2
+          IF ( learning(pfid) .AND.&
+            & SUM(ABS(varseq(pfid,ib+1:ib+overlap(pfid)) -&
+            & varseq(pfid,sp-overlap(pfid)+1:sp))) == 0 ) THEN
+            learning(pfid) = .FALSE.
+            varseq_len(pfid) = sp-overlap(pfid)-ib
+            varseq_pos(pfid) = overlap(pfid)+ib
+            varseq(pfid,1:varseq_len(pfid)) = &
+ &            varseq(pfid,ib+1:ib+varseq_len(pfid))
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+  ELSE
+!-
+!-- 2.0 Now we know how the calls to histwrite are sequenced
+!--     and we can get a guess at the var ID
+!-
+    nn = varseq_pos(pfid)+1
+    IF (nn > varseq_len(pfid)) nn = 1
+!-
+    pvid = varseq(pfid,nn)
+!-
+    IF (TRIM(name(pfid,pvid)) /= TRIM(pvarname)) THEN
+      CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos)
+      IF (pos > 0) THEN
+        pvid = pos
+      ELSE
+        CALL ipslerr (3,"histvar_seq", &
+ &  'The name of the variable you gave has not been declared',&
+ &  'You should use subroutine histdef for declaring variable', &
+ &  TRIM(pvarname))
+      ENDIF
+      varseq_err(pfid) = varseq_err(pfid)+1
+    ELSE
+!-
+!---- We only keep the new position if we have found the variable
+!---- this way. This way an out of sequence call to histwrite does
+!---- not defeat the process.
+!-
+      varseq_pos(pfid) = nn
+    ENDIF
+!-
+    IF (varseq_err(pfid) .GE. 10) THEN
+      WRITE(str70,'("for file ",I3)') pfid
+      CALL ipslerr (2,"histvar_seq", &
+ &  'There were 10 errors in the learned sequence of variables',&
+ &  str70,'This looks like a bug, please report it.')
+         varseq_err(pfid) = 0
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &   'histvar_seq, end of the subroutine :',TRIM(pvarname),pvid
+  ENDIF
+!-------------------------
+END SUBROUTINE histvar_seq
+!===
+SUBROUTINE histsync (file)
+!---------------------------------------------------------------------
+!- This subroutine will synchronise all
+!- (or one if defined) opened files.
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! file  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: file
+!-
+  INTEGER :: ifile,ncid,iret
+!-
+  LOGICAL :: file_exists
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) 'Entering loop on files : ',nb_files
+!-
+! 1.The loop on files to synchronise
+!-
+  DO ifile = 1,nb_files
+!-
+    IF (PRESENT(file)) THEN
+      file_exists = (ifile == file)
+    ELSE
+      file_exists = .TRUE.
+    ENDIF
+!-
+    IF (file_exists) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) 'Synchronising specified file number :',file
+      ENDIF
+      ncid = ncdf_ids(ifile)
+      iret = NF90_SYNC (ncid)
+    ENDIF
+!-
+  ENDDO
+!----------------------
+END SUBROUTINE histsync
+!===
+SUBROUTINE histclo (fid)
+!---------------------------------------------------------------------
+!- This subroutine will close all (or one if defined) opened files
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! fid  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: fid
+!-
+  INTEGER :: ifile,ncid,iret,iv
+  INTEGER :: start_loop,end_loop
+  CHARACTER(LEN=70) :: str70
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) 'Entering loop on files :',nb_files
+!-
+  IF (PRESENT(fid)) THEN
+    start_loop = fid
+    end_loop = fid
+  ELSE
+    start_loop = 1
+    end_loop = nb_files
+  ENDIF
+!-
+  DO ifile=start_loop,end_loop
+    IF (l_dbg) WRITE(*,*) 'Closing specified file number :',ifile
+    ncid = ncdf_ids(ifile)
+    iret = NF90_REDEF (ncid)
+!---
+!-- 1. Loop on the number of variables to add some final information
+!---
+    IF (l_dbg) WRITE(*,*) 'Entering loop on vars : ',nb_var(ifile)
+    DO iv=1,nb_var(ifile)
+      IF (hist_wrt_rng(ifile,iv)) THEN
+        IF (l_dbg) THEN
+          WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
+         &           ' is : ',hist_minmax(ifile,iv,1)
+          WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
+         &           ' is : ',hist_minmax(ifile,iv,2)
+        ENDIF
+        IF (hist_calc_rng(ifile,iv)) THEN
+!-------- Put the min and max values on the file
+          iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_min', &
+ &                             REAL(hist_minmax(ifile,iv,1),KIND=4))
+          iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_max', &
+ &                             REAL(hist_minmax(ifile,iv,2),KIND=4))
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+!-- 2. Close the file
+!---
+    IF (l_dbg) WRITE(*,*) 'close file :',ncid
+    iret = NF90_CLOSE (ncid)
+    IF (iret /= NF90_NOERR) THEN
+      WRITE(str70,'("This file has been already closed :",I3)') ifile
+      CALL ipslerr (2,'histclo',str70,'','')
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE histclo
+!===
+SUBROUTINE ioconf_modname (str)
+!---------------------------------------------------------------------
+!- This subroutine allows to configure the name
+!- of the model written into the file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: str
+!---------------------------------------------------------------------
+  IF (.NOT.lock_modname) THEN
+    model_name = str(1:MIN(LEN_TRIM(str),80))
+    lock_modname = .TRUE.
+  ELSE
+    CALL ipslerr (2,"ioconf_modname", &
+   &  'The model name can only be changed once and only', &
+   &  'before it is used. It is now set to :',model_name)
+  ENDIF
+!----------------------------
+END SUBROUTINE ioconf_modname
+!-
+!===
+!-
+!-----------------
+END MODULE histcom
Index: IOIPSL/tags/v2_1_9/src/ioipsl.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/ioipsl.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/ioipsl.f90	(revision 715)
@@ -0,0 +1,17 @@
+MODULE ioipsl
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!
+  USE errioipsl 
+  USE stringop
+  USE mathelp    
+  USE getincom
+  USE calendar   
+  USE fliocom    
+  USE flincom    
+  USE histcom    
+  USE restcom
+END MODULE ioipsl
Index: IOIPSL/tags/v2_1_9/src/mathelp.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/mathelp.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/mathelp.f90	(revision 715)
@@ -0,0 +1,3116 @@
+MODULE mathelp
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE errioipsl,ONLY : ipslerr
+  USE stringop
+!-
+  PRIVATE
+  PUBLIC :: mathop,moycum,buildop
+!-
+  INTERFACE mathop
+    MODULE PROCEDURE mathop_r11,mathop_r21,mathop_r31
+  END INTERFACE
+!-
+!- Variables used to detect and identify the operations
+!-
+  CHARACTER(LEN=80),SAVE :: &
+ &  seps='( ) , + - / * ^', ops = '+ - * / ^', mima = 'min max'
+  CHARACTER(LEN=250),SAVE :: &
+ &  funcs = 'sin cos tan asin acos atan exp log sqrt chs abs '&
+ & //'cels kelv deg rad gather scatter fill coll undef only ident'
+  CHARACTER(LEN=120),SAVE :: &
+ &  indexfu = 'gather, scatter, fill, coll, undef, only'
+!---------------------------------------------------------------------
+CONTAINS
+!===
+SUBROUTINE buildop (str,ex_topps,topp,nbops_max, &
+ &                  missing_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+!- This subroutine decomposes the input string in the elementary
+!- functions which need to be applied to the vector of data.
+!- This vector is represented by X in the string.
+!- This subroutine is the driver of the decomposition and gets
+!- the time operation but then call decoop for the other operations
+!-
+!- INPUT
+!-
+!- str      : String containing the operations
+!- ex_toops : The time operations that can be expected
+!-            within the string
+!-
+!- OUTPUT
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=80) :: str
+  CHARACTER(LEN=*) :: ex_topps
+  CHARACTER(LEN=7) :: topp
+  INTEGER :: nbops_max,nbops
+  CHARACTER(LEN=7) :: opps(nbops_max)
+  REAL :: scal(nbops_max),missing_val
+!-
+  CHARACTER(LEN=80) :: new_str
+  INTEGER :: leng,ind_opb,ind_clb
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning'
+!-
+  leng = LEN_TRIM(str)
+  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
+    str = str(2:leng-1)
+    leng = leng-2
+  ENDIF
+!-
+  IF (check) &
+ &  WRITE(*,*) 'buildop : Starting to test the various options'
+!-
+  IF (leng <= 5 .AND. INDEX(ex_topps,str(1:leng)) > 0) THEN
+    IF (check) WRITE(*,*) 'buildop : Time operation only'
+    nbops = 0
+    topp = str(1:leng)
+  ELSE
+    IF (check) THEN
+      WRITE(*,*) 'buildop : Time operation and something else'
+    ENDIF
+!--
+    ind_opb = INDEX(str(1:leng),'(')
+    IF (ind_opb > 0) THEN
+      IF (INDEX(ex_topps,str(1:ind_opb-1)) > 0) THEN
+        IF (check) THEN
+          WRITE(*,'(2a)') &
+ &          ' buildop : Extract time operation from : ',str
+        ENDIF
+        topp = str(1:ind_opb-1)
+        ind_clb = INDEX(str(1:leng),')',BACK=.TRUE.)
+        new_str = str(ind_opb+1:ind_clb-1)
+        IF (check) THEN
+          WRITE(*,'(2a,2I3)') &
+ &          ' buildop : Call decoop ',new_str,ind_opb,ind_clb
+        ENDIF
+        CALL decoop (new_str,nbops_max,missing_val,opps,scal,nbops)
+      ELSE
+        CALL ipslerr(3,'buildop', &
+ &        'time operation does not exist',str(1:ind_opb-1),' ')
+      ENDIF
+    ELSE
+      CALL ipslerr(3,'buildop', &
+ &      'some long operation exists but wihout parenthesis', &
+ &      str(1:leng),' ')
+    ENDIF
+  ENDIF
+!-
+  IF (check) THEN
+    DO leng=1,nbops
+      WRITE(*,*) &
+ &      'buildop : i -- opps, scal : ',leng,opps(leng),scal(leng)
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE buildop
+!===
+SUBROUTINE decoop (pstr,nbops_max,missing_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=80) :: pstr
+  INTEGER :: nbops_max,nbops
+  CHARACTER(LEN=7) :: opps(nbops_max)
+  REAL :: scal(nbops_max),missing_val
+!-
+  CHARACTER(LEN=1) :: f_char(2),s_char(2)
+  INTEGER :: nbsep,f_pos(2),s_pos(2)
+  CHARACTER(LEN=20) :: opp_str,scal_str
+  CHARACTER(LEN=80) :: str
+  INTEGER :: xpos,leng,ppos,epos,int_tmp
+  CHARACTER(LEN=3) :: tl,dl
+  CHARACTER(LEN=10) :: fmt
+!-
+  LOGICAL :: check = .FALSE.,prio
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,'(2a)') ' decoop : Incoming string : ',pstr
+!-
+  nbops = 0
+  str = pstr
+!-
+  CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
+  IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep
+  DO WHILE (nbsep > 0)
+    xpos = INDEX(str,'X')
+    leng = LEN_TRIM(str)
+    nbops = nbops+1
+!--
+    IF (check) THEN
+      WRITE(*,*) 'decoop : str -->',str(1:leng)
+      WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2)
+      WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2)
+    ENDIF
+!--
+    IF (nbops > nbops_max-1) THEN
+      CALL ipslerr(3,'decoop','Expression too complex',str,' ')
+    ENDIF
+!--
+    IF (check) WRITE(*,*) 'decoop : --',nbops,' ',str(1:leng)
+!---
+!-- Start the analysis of the syntax. 3 types of constructs
+!-- are recognized.  They are scanned sequentialy
+!---
+    IF (nbsep == 1) THEN
+      IF (check) WRITE(*,*) 'decoop : Only one operation'
+      IF (INDEX(ops,f_char(1)) > 0) THEN
+!------ Type : scal+X
+        IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
+          opp_str = f_char(1)//'I'
+        ELSE
+          opp_str = f_char(1)
+        ENDIF
+        scal_str = str(s_pos(1)+1:f_pos(1)-1)
+        str = 'X'
+      ELSE IF (INDEX(ops,f_char(2)) > 0) THEN
+!------ Type : X+scal
+        opp_str = f_char(2)
+        scal_str = str(f_pos(2)+1:s_pos(2)-1)
+        str = 'X'
+      ELSE
+        CALL ipslerr(3,'decoop', &
+ &        'Unknown operations of type X+scal',f_char(1),pstr)
+      ENDIF
+    ELSE
+      IF (check) WRITE(*,*) 'decoop : More complex operation'
+      IF ( f_char(1) == '(' .AND. f_char(2) == ')' ) THEN
+!------ Type : sin(X)
+        opp_str = str(s_pos(1)+1:f_pos(1)-1)
+        scal_str = '?'
+        str = str(1:s_pos(1))//'X'//str(f_pos(2)+1:leng)
+      ELSE IF (    (f_char(1) == '(' .AND. f_char(2) == ',')&
+ &             .OR.(f_char(1) == ',' .AND. f_char(2) == ')')) THEN
+!------ Type : max(X,scal) or max(scal,X)
+        IF (f_char(1) == '(' .AND. s_char(2) == ')') THEN
+!-------- Type : max(X,scal)
+          opp_str = str(f_pos(1)-3:f_pos(1)-1)
+          scal_str = str(f_pos(2)+1:s_pos(2)-1)
+          str = str(1:f_pos(1)-4)//'X'//str(s_pos(2)+1:leng)
+        ELSE IF (f_char(1) == ',' .AND. s_char(1) == '(') THEN
+!-------- Type : max(scal,X)
+          opp_str = str(s_pos(1)-3:s_pos(1)-1)
+          scal_str = str(s_pos(1)+1:f_pos(1)-1)
+          str = str(1:s_pos(1)-4)//'X'//str(f_pos(2)+1:leng)
+        ELSE
+          CALL ipslerr(3,'decoop','Syntax error 1',str,' ')
+        ENDIF
+      ELSE
+        prio = (f_char(2) == '*').OR.(f_char(2) == '^')
+        IF (     (INDEX(ops,f_char(1)) > 0) &
+ &          .AND.(xpos-f_pos(1) == 1).AND.(.NOT.prio) ) THEN
+!-------- Type : ... scal+X ...
+          IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
+            opp_str = f_char(1)//'I'
+          ELSE
+            opp_str = f_char(1)
+          ENDIF
+          scal_str = str(s_pos(1)+1:f_pos(1)-1)
+          str = str(1:s_pos(1))//'X'//str(f_pos(1)+2:leng)
+        ELSE IF (     (INDEX(ops,f_char(2)) > 0) &
+ &               .AND.(f_pos(2)-xpos == 1) ) THEN
+!-------- Type : ... X+scal ...
+          opp_str = f_char(2)
+          scal_str = str(f_pos(2)+1:s_pos(2)-1)
+          str = str(1:f_pos(2)-2)//'X'//str(s_pos(2):leng)
+        ELSE
+          CALL ipslerr(3,'decoop','Syntax error 2',str,' ')
+        ENDIF
+      ENDIF
+    ENDIF
+!---
+    IF (check) WRITE(*,*) 'decoop : Finished syntax,str = ',TRIM(str)
+!---
+!-- Now that the different components of the operation are identified
+!-- we transform them into what is going to be used in the program
+!---
+    IF (INDEX(scal_str,'?') > 0) THEN
+      IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN
+        opps(nbops) = opp_str(1:LEN_TRIM(opp_str))
+        scal(nbops) =  missing_val
+      ELSE
+        CALL ipslerr(3,'decoop', &
+ &        'Unknown function',opp_str(1:LEN_TRIM(opp_str)),' ')
+      ENDIF
+    ELSE
+      leng = LEN_TRIM(opp_str)
+      IF (INDEX(mima,opp_str(1:leng)) > 0) THEN
+        opps(nbops) = 'fu'//opp_str(1:leng)
+      ELSE
+        IF (INDEX(opp_str(1:leng),'+') > 0) THEN
+          opps(nbops) = 'add'
+        ELSE IF (INDEX(opp_str(1:leng),'-I') > 0) THEN
+          opps(nbops) = 'subi'
+        ELSE IF (INDEX(opp_str(1:leng),'-') > 0) THEN
+          opps(nbops) = 'sub'
+        ELSE IF (INDEX(opp_str(1:leng),'*') > 0) THEN
+          opps(nbops) = 'mult'
+        ELSE IF (INDEX(opp_str(1:leng),'/') > 0) THEN
+          opps(nbops) = 'div'
+        ELSE IF (INDEX(opp_str(1:leng),'/I') > 0) THEN
+          opps(nbops) = 'divi'
+        ELSE IF (INDEX(opp_str(1:leng),'^') > 0) THEN
+          opps(nbops) = 'power'
+        ELSE
+          CALL ipslerr(3,'decoop', &
+ &          'Unknown operation',opp_str(1:leng),' ')
+        ENDIF
+      ENDIF
+!-----
+      leng = LEN_TRIM(scal_str)
+      ppos = INDEX(scal_str,'.')
+      epos = INDEX(scal_str,'e')
+      IF (epos == 0) epos = INDEX(scal_str,'E')
+!-----
+!---- Try to catch a few errors
+!-----
+      IF (INDEX(ops,scal_str) > 0) THEN
+        CALL ipslerr(3,'decoop', &
+ &        'Strange scalar you have here ',scal_str,pstr)
+      ENDIF
+      IF (epos > 0) THEN
+        WRITE(tl,'(I3.3)') leng
+        WRITE(dl,'(I3.3)') epos-ppos-1
+        fmt='(e'//tl//'.'//dl//')'
+        READ(scal_str,fmt) scal(nbops)
+      ELSE IF (ppos > 0) THEN
+        WRITE(tl,'(I3.3)') leng
+        WRITE(dl,'(I3.3)') leng-ppos
+        fmt='(f'//tl//'.'//dl//')'
+        READ(scal_str,fmt) scal(nbops)
+      ELSE
+        WRITE(tl,'(I3.3)') leng
+        fmt = '(I'//tl//')'
+        READ(scal_str,fmt) int_tmp
+        scal(nbops) = REAL(int_tmp)
+      ENDIF
+    ENDIF
+    IF (check) WRITE(*,*) 'decoop : Finished interpretation'
+    CALL findsep(str,nbsep,f_char,f_pos,s_char,s_pos)
+  ENDDO
+!--------------------
+END SUBROUTINE decoop
+!===
+SUBROUTINE findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
+!---------------------------------------------------------------------
+!- Subroutine finds all separators in a given string
+!- It returns the following information about str :
+!-   f_char : The first separation character
+!-            (1 for before and 2 for after)
+!-   f_pos  : The position of the first separator
+!-   s_char : The second separation character
+!-            (1 for before and 2 for after)
+!-   s_pos  : The position of the second separator
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=80) :: str
+  INTEGER :: nbsep
+  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
+  INTEGER,DIMENSION(2) :: f_pos,s_pos
+!-
+  CHARACTER(LEN=70) :: str_tmp
+  LOGICAL :: f_found,s_found
+  INTEGER :: ind,xpos,leng,i
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) 'findsep : call cleanstr: ',TRIM(str)
+!-
+  CALL cleanstr(str)
+!-
+  IF (check) WRITE(*,*) 'findsep : out of cleanstr: ',TRIM(str)
+!-
+  xpos = INDEX(str,'X')
+  leng = LEN_TRIM(str)
+!-
+  f_pos(1:2) = (/ 0,leng+1 /)
+  f_char(1:2) = (/ '?','?' /)
+  s_pos(1:2) = (/ 0,leng+1 /)
+  s_char(1:2) = (/ '?','?' /)
+!-
+  nbsep = 0
+!-
+  f_found = .FALSE.
+  s_found = .FALSE.
+  IF (xpos > 1) THEN
+    DO i=xpos-1,1,-1
+      ind = INDEX(seps,str(i:i))
+      IF (ind > 0) THEN
+        IF (.NOT.f_found) THEN
+          f_char(1) = str(i:i)
+          f_pos(1) = i
+          nbsep = nbsep+1
+          f_found = .TRUE.
+        ELSE IF (.NOT.s_found) THEN
+          s_char(1) = str(i:i)
+          s_pos(1) = i
+          nbsep = nbsep+1
+          s_found = .TRUE.
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  f_found = .FALSE.
+  s_found = .FALSE.
+  IF (xpos < leng) THEN
+    DO i=xpos+1,leng
+      ind = INDEX(seps,str(i:i))
+      IF (ind > 0) THEN
+        IF (.NOT.f_found) THEN
+          f_char(2) = str(i:i)
+          f_pos(2) = i
+          nbsep = nbsep+1
+          f_found = .TRUE.
+        ELSE IF (.NOT.s_found) THEN
+          s_char(2) = str(i:i)
+          s_pos(2) = i
+          nbsep = nbsep+1
+          s_found = .TRUE.
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF (nbsep > 4) THEN
+    WRITE(str_tmp,'("number :",I3)') nbsep
+    CALL ipslerr(3,'findsep', &
+ &    'How can I find that many separators',str_tmp,str)
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'Finished findsep : ',nbsep,leng
+!---------------------
+END SUBROUTINE findsep
+!===
+SUBROUTINE cleanstr(str)
+!---------------------------------------------------------------------
+!- We clean up the string by taking out the extra () and puting
+!- everything in lower case except for the X describing the variable
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=80) :: str
+!-
+  INTEGER :: ind,leng,ic,it
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  leng = LEN_TRIM(str)
+  CALL strlowercase(str)
+!-
+  ind = INDEX(str,'x')
+  IF (check) THEN
+    WRITE (*,*) 'cleanstr 1.0 : ind = ',ind, &
+&               ' str = ',str(1:leng),'---'
+  ENDIF
+!-
+! If the character before the x is not a letter then we can assume
+! that it is the variable and promote it to a capital letter
+!-
+  DO WHILE (ind > 0)
+    ic = 0
+    IF (ind > 1) ic = IACHAR(str(ind-1:ind-1))
+    IF (ic < 97 .OR. ic > 122) THEN
+      str(ind:ind) = 'X'
+    ENDIF
+    it = INDEX(str(ind+1:leng),'x')
+    IF (it > 0) THEN
+      ind = ind+it
+    ELSE
+      ind = it
+    ENDIF
+  ENDDO
+!-
+  IF (check) WRITE (*,*) 'cleanstr 2.0 : str = ',str(1:leng),'---'
+!-
+  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
+    str = str(2:leng-1)
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 3.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str,'((X))')
+  IF (ind > 0) THEN
+    str=str(1:ind-1)//'(X)'//str(ind+5:leng)//'  '
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 4.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str,'(X)')
+  IF (ind > 0 .AND. ind+3 < leng) THEN
+    IF (      (INDEX(seps,str(ind-1:ind-1)) > 0) &
+ &      .AND. (INDEX(seps,str(ind+3:ind+3)) > 0) ) THEN
+      str=str(1:ind-1)//'X'//str(ind+3:leng)//'  '
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 5.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str(1:leng),' ')
+  DO WHILE (ind > 0)
+    str=str(1:ind-1)//str(ind+1:leng)//' '
+    leng = LEN_TRIM(str)
+    ind = INDEX(str(1:leng),' ')
+  ENDDO
+!-
+  IF (check) WRITE (*,*) 'cleanstr 6.0 : str = ',str(1:leng),'---'
+!----------------------
+END SUBROUTINE cleanstr
+!===
+!===
+SUBROUTINE mathop_r11 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operation
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb,nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r11(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r11(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r11(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r11(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r11(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r11(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r11(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r11(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r11(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r11(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r11(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r11(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r11(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r11(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r11(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r11(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > nb) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r11(nb,work_in,nb_index,nindex, &
+&                              miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing',&
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r11", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r11(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r11
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = SIN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_sin_r11 = 0
+!----------------------
+END FUNCTION ma_sin_r11
+!===
+INTEGER FUNCTION ma_cos_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = COS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_cos_r11 = 0
+!----------------------
+END FUNCTION ma_cos_r11
+!===
+INTEGER FUNCTION ma_tan_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = TAN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_tan_r11 = 0
+!----------------------
+END FUNCTION ma_tan_r11
+!===
+INTEGER FUNCTION ma_asin_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ASIN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_asin_r11 = 0
+!-----------------------
+END FUNCTION ma_asin_r11
+!===
+INTEGER FUNCTION ma_acos_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ACOS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_acos_r11 = 0
+!-----------------------
+END FUNCTION ma_acos_r11
+!===
+INTEGER FUNCTION ma_atan_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ATAN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_atan_r11 = 0
+!-----------------------
+END FUNCTION ma_atan_r11
+!===
+INTEGER FUNCTION ma_exp_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = EXP(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_exp_r11 = 0
+!----------------------
+END FUNCTION ma_exp_r11
+!===
+INTEGER FUNCTION ma_log_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = log(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_log_r11 = 0
+!----------------------
+END FUNCTION ma_log_r11
+!===
+INTEGER FUNCTION ma_sqrt_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = SQRT(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_sqrt_r11 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r11
+!===
+INTEGER FUNCTION ma_abs_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ABS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_abs_r11 = 0
+!----------------------
+END FUNCTION ma_abs_r11
+!===
+INTEGER FUNCTION ma_chs_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*(-1.)
+  ENDDO
+!-
+  nbo = nb
+  ma_chs_r11 = 0
+!----------------------
+END FUNCTION ma_chs_r11
+!===
+INTEGER FUNCTION ma_cels_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)-273.15
+  ENDDO
+!-
+  nbo = nb
+  ma_cels_r11 = 0
+!-----------------------
+END FUNCTION ma_cels_r11
+!===
+INTEGER FUNCTION ma_kelv_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)+273.15
+  ENDDO
+!-
+  nbo = nb
+  ma_kelv_r11 = 0
+!-----------------------
+END FUNCTION ma_kelv_r11
+!===
+INTEGER FUNCTION ma_deg_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*57.29577951
+  ENDDO
+!-
+  nbo = nb
+  ma_deg_r11 = 0
+!-----------------------
+END FUNCTION ma_deg_r11
+!===
+INTEGER FUNCTION ma_rad_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*0.01745329252
+  ENDDO
+!-
+  nbo = nb
+  ma_rad_r11 = 0
+!----------------------
+END FUNCTION ma_rad_r11
+!===
+INTEGER FUNCTION ma_ident_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_ident_r11 = 0
+!------------------------
+END FUNCTION ma_ident_r11
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)+s
+  ENDDO
+!-
+  nbo = nb
+  ma_add_r11 = 0
+!-----------------------
+  END FUNCTION ma_add_r11
+!===
+INTEGER FUNCTION ma_sub_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)-s
+  ENDDO
+!-
+  nbo = nb
+  ma_sub_r11 = 0
+!----------------------
+END FUNCTION ma_sub_r11
+!===
+INTEGER FUNCTION ma_subi_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) =  s-x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_subi_r11 = 0
+!-----------------------
+END FUNCTION ma_subi_r11
+!===
+INTEGER FUNCTION ma_mult_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*s
+  ENDDO
+!-
+  nbo = nb
+  ma_mult_r11 = 0
+!-----------------------
+END FUNCTION ma_mult_r11
+!===
+INTEGER FUNCTION ma_div_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)/s
+  ENDDO
+!-
+  nbo = nb
+  ma_div_r11 = 0
+!-----------------------
+  END FUNCTION ma_div_r11
+!===
+INTEGER FUNCTION ma_divi_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = s/x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_divi_r11 = 0
+!-----------------------
+END FUNCTION ma_divi_r11
+!===
+INTEGER FUNCTION ma_power_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)**s
+  ENDDO
+!-
+  nbo = nb
+  ma_power_r11 = 0
+!-----------------------
+END FUNCTION ma_power_r11
+!===
+INTEGER FUNCTION ma_fumin_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = MIN(x(i),s)
+  ENDDO
+!-
+  nbo = nb
+  ma_fumin_r11 = 0
+!------------------------
+END FUNCTION ma_fumin_r11
+!===
+INTEGER FUNCTION ma_fumax_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = MAX(x(i),s)
+  ENDDO
+!-
+  nbo = nb
+  ma_fumax_r11 = 0
+!------------------------
+END FUNCTION ma_fumax_r11
+!===
+INTEGER FUNCTION ma_fuscat_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ii,ipos
+!---------------------------------------------------------------------
+  ma_fuscat_r11 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb) THEN
+    ipos = 0
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        ipos = ipos+1
+        y(ind(i)) = x(ipos)
+      ELSE
+        IF (ind(i) > nbo) ma_fuscat_r11  = ma_fuscat_r11+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r11  = ma_fuscat_r11+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r11  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r11
+!===
+INTEGER FUNCTION ma_fugath_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r11 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    DO i=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(i) > 0) THEN
+          ipos = ipos+1
+          y(ipos) = x(ind(i))
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r11  = ma_fugath_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r11 = 1
+  ENDIF
+!-
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r11
+!===
+INTEGER FUNCTION ma_fufill_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ii,ipos
+!---------------------------------------------------------------------
+  ma_fufill_r11 = 0
+!-
+  IF (nbi <= nb) THEN
+    ipos = 0
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        ipos = ipos+1
+        y(ind(i)) = x(ipos)
+      ELSE
+        IF (ind(i) > nbo) ma_fufill_r11  = ma_fufill_r11+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r11  = ma_fufill_r11+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r11  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r11
+!===
+INTEGER FUNCTION ma_fucoll_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r11 = 0
+    ipos = 0
+    DO i=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(i) > 0) THEN
+          ipos = ipos+1
+          y(ipos) = x(ind(i))
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r11  = ma_fucoll_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r11 = 1
+  ENDIF
+!-
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r11
+!===
+INTEGER FUNCTION ma_fuundef_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb) THEN
+    ma_fuundef_r11 = 0
+    DO i=1,nbo
+      y(i) = x(i)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r11  = ma_fuundef_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r11 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r11
+!===
+INTEGER FUNCTION ma_fuonly_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r11 = 0
+    y(1:nbo) = miss_val
+    DO i=1,nbi
+      IF (ind(i) > 0) THEN
+        y(ind(i)) =  x(ind(i))
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r11 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r11
+!===
+!===
+SUBROUTINE mathop_r21 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operations
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb(2),nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb(1),nb(2)),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r21(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r21(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r21(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r21(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r21(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r21(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r21(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r21(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r21(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r21(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r21(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r21(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r21(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r21(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r21(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r21(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r21(nb,work_in,nb_index,nindex, &
+ &                            miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > (nb(1)*nb(2)) ) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r21(nb,work_in,nb_index,nindex, &
+ &                             miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing', &
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r21", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r21(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r21
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = SIN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sin_r21 = 0
+!----------------------
+END FUNCTION ma_sin_r21
+!===
+INTEGER FUNCTION ma_cos_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = COS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_cos_r21 = 0
+!----------------------
+END FUNCTION ma_cos_r21
+!===
+INTEGER FUNCTION ma_tan_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = TAN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_tan_r21 = 0
+!----------------------
+END FUNCTION ma_tan_r21
+!===
+  INTEGER FUNCTION ma_asin_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ASIN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_asin_r21 = 0
+!-----------------------
+END FUNCTION ma_asin_r21
+!===
+INTEGER FUNCTION ma_acos_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ACOS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_acos_r21 = 0
+!-----------------------
+END FUNCTION ma_acos_r21
+!===
+INTEGER FUNCTION ma_atan_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ATAN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_atan_r21 = 0
+!-----------------------
+END FUNCTION ma_atan_r21
+!===
+INTEGER FUNCTION ma_exp_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = EXP(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_exp_r21 = 0
+!----------------------
+END FUNCTION ma_exp_r21
+!===
+INTEGER FUNCTION ma_log_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = LOG(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_log_r21 = 0
+!----------------------
+END FUNCTION ma_log_r21
+!===
+INTEGER FUNCTION ma_sqrt_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = SQRT(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sqrt_r21 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r21
+!===
+INTEGER FUNCTION ma_abs_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ABS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_abs_r21 = 0
+!----------------------
+END FUNCTION ma_abs_r21
+!===
+INTEGER FUNCTION ma_chs_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*(-1.)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_chs_r21 = 0
+!----------------------
+END FUNCTION ma_chs_r21
+!===
+INTEGER FUNCTION ma_cels_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)-273.15
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_cels_r21 = 0
+!-----------------------
+END FUNCTION ma_cels_r21
+!===
+INTEGER FUNCTION ma_kelv_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)+273.15
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_kelv_r21 = 0
+!-----------------------
+END FUNCTION ma_kelv_r21
+!===
+INTEGER FUNCTION ma_deg_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*57.29577951
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_deg_r21 = 0
+!----------------------
+END FUNCTION ma_deg_r21
+!===
+INTEGER FUNCTION ma_rad_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*0.01745329252
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_rad_r21 = 0
+!----------------------
+END FUNCTION ma_rad_r21
+!===
+INTEGER FUNCTION ma_ident_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_ident_r21 = 0
+!------------------------
+END FUNCTION ma_ident_r21
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)+s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_add_r21 = 0
+!----------------------
+END FUNCTION ma_add_r21
+!===
+INTEGER FUNCTION ma_sub_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)-s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sub_r21 = 0
+!----------------------
+END FUNCTION ma_sub_r21
+!===
+INTEGER FUNCTION ma_subi_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) =  s-x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_subi_r21 = 0
+!-----------------------
+END FUNCTION ma_subi_r21
+!===
+INTEGER FUNCTION ma_mult_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_mult_r21 = 0
+!-----------------------
+END FUNCTION ma_mult_r21
+!===
+INTEGER FUNCTION ma_div_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)/s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_div_r21 = 0
+!----------------------
+END FUNCTION ma_div_r21
+!===
+INTEGER FUNCTION ma_divi_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = s/x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_divi_r21 = 0
+!-----------------------
+END FUNCTION ma_divi_r21
+!===
+INTEGER FUNCTION ma_power_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j) ** s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_power_r21 = 0
+!------------------------
+END FUNCTION ma_power_r21
+!===
+INTEGER FUNCTION ma_fumin_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = MIN(x(i,j),s)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_fumin_r21 = 0
+!------------------------
+END FUNCTION ma_fumin_r21
+!===
+INTEGER FUNCTION ma_fumax_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = MAX(x(i,j),s)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_fumax_r21 = 0
+!------------------------
+END FUNCTION ma_fumax_r21
+!===
+INTEGER FUNCTION ma_fuscat_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ii,ipos
+!---------------------------------------------------------------------
+  ma_fuscat_r21 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb(1)*nb(2)) THEN
+    ipos = 0
+    DO ij=1,nbi
+       IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+         ipos = ipos+1
+         j = ((ipos-1)/nb(1))+1
+         i = (ipos-(j-1)*nb(1))
+         y(ind(ij)) = x(i,j)
+       ELSE
+         IF (ind(ij) > nbo) ma_fuscat_r21  = ma_fuscat_r21+1
+       ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r21  = ma_fuscat_r21+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r21  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r21
+!===
+INTEGER FUNCTION ma_fugath_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r21 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          j = ((ind(ij)-1)/nb(1))+1
+          i = (ind(ij)-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r21  = ma_fugath_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r21 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r21
+!===
+INTEGER FUNCTION ma_fufill_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ii,ipos
+!---------------------------------------------------------------------
+  ma_fufill_r21 = 0
+!-
+  IF (nbi <= nb(1)*nb(2)) THEN
+    ipos = 0
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        j = ((ipos-1)/nb(1))+1
+        i = (ipos-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j)
+      ELSE
+        IF (ind(ij) > nbo) ma_fufill_r21  = ma_fufill_r21+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r21  = ma_fufill_r21+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r21  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r21
+!===
+INTEGER FUNCTION ma_fucoll_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r21 = 0
+    ipos = 0
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          j = ((ind(ij)-1)/nb(1))+1
+          i = (ind(ij)-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r21  = ma_fucoll_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r21 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r21
+!===
+INTEGER FUNCTION ma_fuundef_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)) THEN
+    ma_fuundef_r21 = 0
+    DO ij=1,nbo
+      j = ((ij-1)/nb(1))+1
+      i = (ij-(j-1)*nb(1))
+      y(ij) = x(i,j)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r21 = ma_fuundef_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r21 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r21
+!===
+INTEGER FUNCTION ma_fuonly_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r21 = 0
+    y(1:nbo) = miss_val
+    DO ij=1,nbi
+      IF (ind(ij) > 0) THEN
+        j = ((ind(ij)-1)/nb(1))+1
+        i = (ind(ij)-(j-1)*nb(1))
+        y(ind(ij)) =  x(i,j)
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r21 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r21
+!===
+!===
+SUBROUTINE mathop_r31 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operations
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb(3),nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb(1),nb(2),nb(3)),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r31(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r31(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r31(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r31(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r31(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r31(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r31(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r31(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r31(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r31(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r31(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r31(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r31(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r31(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r31(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r31(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+         CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > (nb(1)*nb(2)*nb(3))) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r31(nb,work_in,nb_index,nindex, &
+ &                             miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing', &
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r31", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r31(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r31
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = SIN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sin_r31 = 0
+!----------------------
+END FUNCTION ma_sin_r31
+!===
+INTEGER FUNCTION ma_cos_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = COS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_cos_r31 = 0
+!----------------------
+END FUNCTION ma_cos_r31
+!===
+INTEGER FUNCTION ma_tan_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = TAN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_tan_r31 = 0
+!----------------------
+END FUNCTION ma_tan_r31
+!===
+INTEGER FUNCTION ma_asin_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ASIN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_asin_r31 = 0
+!-----------------------
+END FUNCTION ma_asin_r31
+!===
+INTEGER FUNCTION ma_acos_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ACOS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_acos_r31 = 0
+!-----------------------
+END FUNCTION ma_acos_r31
+!===
+INTEGER FUNCTION ma_atan_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ATAN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_atan_r31 = 0
+!-----------------------
+  END FUNCTION ma_atan_r31
+!===
+INTEGER FUNCTION ma_exp_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = EXP(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_exp_r31 = 0
+!----------------------
+END FUNCTION ma_exp_r31
+!===
+INTEGER FUNCTION ma_log_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = LOG(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_log_r31 = 0
+!----------------------
+END FUNCTION ma_log_r31
+!===
+INTEGER FUNCTION ma_sqrt_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = SQRT(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sqrt_r31 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r31
+!===
+INTEGER FUNCTION ma_abs_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ABS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_abs_r31 = 0
+!----------------------
+END FUNCTION ma_abs_r31
+!===
+INTEGER FUNCTION ma_chs_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*(-1.)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_chs_r31 = 0
+!----------------------
+END FUNCTION ma_chs_r31
+!===
+INTEGER FUNCTION ma_cels_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)-273.15
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_cels_r31 = 0
+!-----------------------
+END FUNCTION ma_cels_r31
+!===
+INTEGER FUNCTION ma_kelv_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)+273.15
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_kelv_r31 = 0
+!-----------------------
+  END FUNCTION ma_kelv_r31
+!===
+INTEGER FUNCTION ma_deg_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*57.29577951
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_deg_r31 = 0
+!----------------------
+END FUNCTION ma_deg_r31
+!===
+INTEGER FUNCTION ma_rad_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*0.01745329252
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_rad_r31 = 0
+!----------------------
+END FUNCTION ma_rad_r31
+!===
+INTEGER FUNCTION ma_ident_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_ident_r31 = 0
+!------------------------
+END FUNCTION ma_ident_r31
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)+s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_add_r31 = 0
+!----------------------
+END FUNCTION ma_add_r31
+!===
+INTEGER FUNCTION ma_sub_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)-s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sub_r31 = 0
+!----------------------
+END FUNCTION ma_sub_r31
+!===
+INTEGER FUNCTION ma_subi_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) =  s-x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_subi_r31 = 0
+!-----------------------
+END FUNCTION ma_subi_r31
+!===
+INTEGER FUNCTION ma_mult_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_mult_r31 = 0
+!-----------------------
+END FUNCTION ma_mult_r31
+!===
+INTEGER FUNCTION ma_div_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)/s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_div_r31 = 0
+!----------------------
+END FUNCTION ma_div_r31
+!===
+INTEGER FUNCTION ma_divi_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = s/x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_divi_r31 = 0
+!-----------------------
+END FUNCTION ma_divi_r31
+!===
+INTEGER FUNCTION ma_power_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)**s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_power_r31 = 0
+!------------------------
+END FUNCTION ma_power_r31
+!===
+INTEGER FUNCTION ma_fumin_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = MIN(x(i,j,k),s)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_fumin_r31 = 0
+!------------------------
+END FUNCTION ma_fumin_r31
+!===
+INTEGER FUNCTION ma_fumax_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = MAX(x(i,j,k),s)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_fumax_r31 = 0
+!------------------------
+END FUNCTION ma_fumax_r31
+!===
+INTEGER FUNCTION ma_fuscat_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
+!---------------------------------------------------------------------
+  ma_fuscat_r31 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        k = ((ipos-1)/isb)+1
+        ipp = ipos-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ELSE
+        IF (ind(ij) > nbo) ma_fuscat_r31  = ma_fuscat_r31+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r31  = ma_fuscat_r31+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r31  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r31
+!===
+INTEGER FUNCTION ma_fugath_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipos,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r31 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          k = ((ind(ij)-1)/isb)+1
+          ipp = ind(ij)-(k-1)*isb
+          j = ((ipp-1)/nb(1))+1
+          i = (ipp-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j,k)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r31  = ma_fugath_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r31 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r31
+!===
+INTEGER FUNCTION ma_fufill_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
+!---------------------------------------------------------------------
+  ma_fufill_r31 = 0
+  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        k = ((ipos-1)/isb)+1
+        ipp = ipos-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ELSE
+        IF (ind(ij) > nbo) ma_fufill_r31  = ma_fufill_r31+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r31  = ma_fufill_r31+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r31  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r31
+!===
+INTEGER FUNCTION ma_fucoll_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipos,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r31 = 0
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          k = ((ind(ij)-1)/isb)+1
+          ipp = ind(ij)-(k-1)*isb
+          j = ((ipp-1)/nb(1))+1
+          i = (ipp-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j,k)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r31  = ma_fucoll_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r31 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r31
+!===
+INTEGER FUNCTION ma_fuundef_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)*nb(3)) THEN
+    ma_fuundef_r31 = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbo
+      k = ((ij-1)/isb)+1
+      ipp = ij-(k-1)*isb
+      j = ((ipp-1)/nb(1))+1
+      i = (ipp-(j-1)*nb(1))
+      y(ij) = x(i,j,k)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r31  = ma_fuundef_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r31 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r31
+!===
+INTEGER FUNCTION ma_fuonly_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipp,isb
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)*nb(3)) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r31 = 0
+    y(1:nbo) = miss_val
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) > 0) THEN
+        k = ((ind(ij)-1)/isb)+1
+        ipp = ind(ij)-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r31 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r31
+!===
+SUBROUTINE moycum (opp,np,px,py,pwx)
+!---------------------------------------------------------------------
+!- Does time operations
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: opp
+  INTEGER :: np
+  REAL,DIMENSION(:) :: px,py
+  INTEGER :: pwx
+!---------------------------------------------------------------------
+  IF (pwx /= 0) THEN
+    IF      (opp == 'ave') THEN
+      px(1:np)=(px(1:np)*pwx+py(1:np))/REAL(pwx+1)
+    ELSE IF (opp == 't_sum') THEN
+      px(1:np)=px(1:np)+py(1:np)
+    ELSE IF ( (opp == 'l_min').OR.(opp == 't_min') ) THEN
+      px(1:np)=MIN(px(1:np),py(1:np))
+    ELSE IF ( (opp == 'l_max').OR.(opp == 't_max') ) THEN
+      px(1:np)=MAX(px(1:np),py(1:np))
+    ELSE
+      CALL ipslerr(3,"moycum",'Unknown time operation',opp,' ')
+    ENDIF
+  ELSE
+    IF      (opp == 'l_min') THEN
+      px(1:np)=MIN(px(1:np),py(1:np))
+    ELSE IF (opp == 'l_max') THEN
+      px(1:np)=MAX(px(1:np),py(1:np))
+    ELSE
+      px(1:np)=py(1:np)
+    ENDIF
+  ENDIF
+!--------------------
+END SUBROUTINE moycum
+!===
+!-----------------
+END MODULE mathelp
Index: IOIPSL/tags/v2_1_9/src/restcom.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/restcom.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/restcom.f90	(revision 715)
@@ -0,0 +1,2546 @@
+MODULE restcom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+USE netcdf
+!-
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop
+USE calendar
+USE mathelp
+USE fliocom,   ONLY : flio_dom_file,flio_dom_att
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: &
+ &  restini, restget, restput, restclo, &
+ &  ioconf_setatt, ioget_vname, ioconf_expval, &
+ &  ioget_expval, ioget_vdim
+!-
+INTERFACE restput
+  MODULE PROCEDURE &
+ &  restput_r3d, restput_r2d, restput_r1d, &
+ &  restput_opp_r2d, restput_opp_r1d
+END INTERFACE
+!-
+INTERFACE restget
+  MODULE PROCEDURE &
+ &  restget_r3d,restget_r2d,restget_r1d, &
+ &  restget_opp_r2d,restget_opp_r1d
+END INTERFACE
+!-
+! We do not use allocatable arrays because these sizes are safe
+! and we do not know from start how many variables will be in
+! the out file.
+!-
+  INTEGER,PARAMETER :: &
+ &  max_var=500, max_file=50, max_dim=NF90_MAX_VAR_DIMS
+!-
+  CHARACTER(LEN=9),SAVE :: calend_str='unknown'
+!-
+! The IDs of the netCDF files are going in pairs.
+! The input one (netcdf_id(?,1)) and the output one (netcdf_id(?,2))
+!-
+  INTEGER,SAVE :: nb_fi = 0
+  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1
+!-
+! Description of the content of the 'in' files and the 'out' files.
+!   Number of variables   : nbvar_*
+!   Number of dimensions  : nbdim_*
+!   ID of the time axis   : tdimid_*
+!-
+  INTEGER,SAVE :: nbvar_in(max_file), nbvar_out(max_file)
+  INTEGER,SAVE :: tdimid_in(max_file), tdimid_out(max_file)
+!-
+! Variables for one or the other file
+!-
+! Number of dimensions in the input file               : nbdim_in
+! Number of variables read so far from the input file  : nbvar_read
+! Type of variable read from the input file            : vartyp_in
+!   (Could be used later to test if we have a restart file)
+!-
+  INTEGER,SAVE :: nbdim_in(max_file), nbvar_read(max_file)
+  INTEGER,SAVE :: vartyp_in(max_file, max_var)
+!-
+! Time step and time origine in the input file.
+!-
+  REAL,DIMENSION(max_file),SAVE :: deltat,timeorig
+!-
+! Description of the axes in the output file
+!-
+!   tstp_out  : Index on the tie axis currently beeing written
+!   itau_out  : Time step which is written on this index of the file
+!-
+  INTEGER,DIMENSION(max_file),SAVE :: tstp_out,itau_out
+!-
+! Description of the axes in the output file
+!-
+! For the ?ax_infs variable the following order is used :
+!   ?ax_infs (if,in,1) = size of axis
+!   ?ax_infs (if,in,2) = id of dimension
+! Number of x,y and z axes in the output file :
+!   ?ax_nb(if)
+!-
+  INTEGER,DIMENSION(max_file,max_dim,2),SAVE :: &
+ &  xax_infs,yax_infs,zax_infs
+  INTEGER,DIMENSION(max_file),SAVE :: &
+ &  xax_nb=0,yax_nb=0,zax_nb=0
+!-
+! Description of the time axes in the input and output files
+!-
+!   ID of the variable which contains the itaus :
+!     tind_varid_*
+!   ID of the variables which contains the seconds since date :
+!     tax_varid_*
+!   Size of the time axis in the input file :
+!     tax_size_in
+!-
+  INTEGER,SAVE :: tind_varid_in(max_file),  tax_varid_in(max_file), &
+ &                tind_varid_out(max_file), tax_varid_out(max_file)
+  INTEGER,SAVE :: tax_size_in(max_file)=1
+!-
+! The two time axes we have in the input file :
+!   t_index   : dates in itaus
+!               (thus the variable has a tstep_sec attribute)
+!   t_julian  : Julian days of the time axis
+!-
+  INTEGER,SAVE,ALLOCATABLE :: t_index(:,:)
+  REAL,SAVE,ALLOCATABLE :: t_julian(:,:)
+!-
+! Here we save a number of informations on the variables
+! in the files we are handling
+!-
+! Name of variables :                                    varname_*
+! ID of the variables :                                  varid_*
+! Number of dimensions of the variable :                 varnbdim_*
+! Dimensions which are used for the variable :           vardims_*
+! Number of attributes for a variables :                 varatt_*
+! A flag which markes the variables we have worked on :  touched_*
+!-
+  CHARACTER(LEN=20),DIMENSION(max_file,max_var),SAVE :: &
+ &  varname_in,varname_out
+  INTEGER,DIMENSION(max_file,max_var),SAVE :: &
+ &  varid_in,varid_out,varnbdim_in,varatt_in
+  INTEGER,DIMENSION(max_file,max_var,max_dim),SAVE :: &
+ &  vardims_in
+  LOGICAL,DIMENSION(max_file,max_var),SAVE :: &
+ &  touched_in,touched_out
+!-
+  CHARACTER(LEN=120),SAVE :: indchfun= 'scatter, fill, gather, coll'
+  REAL,PARAMETER :: missing_val=1.e20
+!                or HUGE(1.0) (maximum real number)
+!-
+! The default value we will use for variables
+! which are not present in the restart file
+!-
+  REAL,SAVE :: val_exp =  999999.
+  LOGICAL,SAVE :: lock_valexp = .FALSE.
+!-
+! Temporary variables in which we store the attributed which are going
+! to be given to a new variable which is going to be defined.
+!-
+  CHARACTER(LEN=80),SAVE :: rest_units='XXXXX',rest_lname='XXXXX'
+!-
+! For allocations
+!-
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp1,buff_tmp2
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE restini &
+ & (fnamein,iim,jjm,lon,lat,llm,lev, &
+ &  fnameout,itau,date0,dt,fid,owrite_time_in,domain_id)
+!---------------------------------------------------------------------
+!- This subroutine sets up all the restart process.
+!- It will call the subroutine which opens the input
+!- and output files.
+!- The time step (itau), date of origine (date0) and time step are
+!- READ from the input file.
+!- A file ID, which is common to the input and output file is returned
+!-
+!- If fnamein = fnameout then the same file is used for the reading
+!- the restart conditions and writing the new restart.
+!-
+!- A special mode can be switched in with filename='NONE'.
+!- This means that no restart file is present.
+!- Usefull for creating the first restart file
+!- or to get elements in a file without creating an output file.
+!-
+!- A mode needs to be written in which itau, date0 and dt
+!- are given to the restart process and thus
+!- written into the output restart file.
+!-
+!- INPUT
+!-
+!- fnamein  : name of the file for the restart
+!- iim      : Dimension in x
+!- jjm      : Dimension in y
+!- lon      : Longitude in the x,y domain
+!- lat      : Latitude in the x,y domain
+!- llm      : Dimension in the vertical
+!- lev      : Positions of the levels
+!- fnameout :
+!-
+!- OUTPUT
+!-
+!- itau     : Time step of the restart file and at which the model
+!-            should restart
+!- date0    : Time at which itau = 0
+!- dt       : time step in seconds between two succesiv itaus
+!- fid      : File identification of the restart file
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!- domain_id      : Domain identifier
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: fnamein,fnameout
+  INTEGER :: iim,jjm,llm,fid,itau
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  REAL :: date0,dt
+  LOGICAL,OPTIONAL :: owrite_time_in
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: ncfid
+  REAL :: dt_tmp,date0_tmp
+  LOGICAL :: l_fi,l_fo,l_rw
+  LOGICAL :: overwrite_time
+  CHARACTER(LEN=120) :: fname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Prepare the configuration before opening any files
+!-
+  IF (.NOT.PRESENT(owrite_time_in)) THEN
+    overwrite_time = .FALSE.
+  ELSE
+    overwrite_time = owrite_time_in
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)
+  ENDIF
+!-
+  nb_fi = nb_fi+1
+!-
+  IF (nb_fi > max_file) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Too many restart files are used. The problem can be',&
+ &   'solved by increasing max_file in restcom.f90 ',&
+ &   'and recompiling ioipsl.')
+  ENDIF
+!-
+! 0.1 Define the open flags
+!-
+  l_fi = (TRIM(fnamein)  /= 'NONE')
+  l_fo = (TRIM(fnameout) /= 'NONE')
+  IF ((.NOT.l_fi).AND.(.NOT.l_fo)) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Input and output file names are both to NONE.',&
+ &   'It is probably an error.','Verify your logic.')
+  ENDIF
+  l_rw = l_fi.AND.l_fo.AND.(TRIM(fnamein) == TRIM(fnameout))
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw
+  ENDIF
+!-
+! 1.0 Open the input file.
+!-
+  IF (l_fi) THEN
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file'
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnamein
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+    netcdf_id(nb_fi,1) = ncfid
+!---
+!-- 1.3 Extract the time information
+!---
+    IF (overwrite_time) THEN
+       date0_tmp = date0
+    ENDIF
+    CALL restsett (dt_tmp,date0_tmp,itau,overwrite_time)
+    IF (.NOT.overwrite_time) THEN
+      dt = dt_tmp
+      date0 = date0_tmp
+    ENDIF
+!---
+  ELSE
+!---
+!-- 2.0 The case of a missing restart file is dealt with
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 2.0'
+!---
+    IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) &
+        .AND.(iim > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the longitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lat(:iim,:jjm)) == MAXLOC(lat(:iim,:jjm)))) &
+        .AND.(jjm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the latitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lev(:llm)) == MAXLOC(lev(:llm)))) &
+        .AND.(llm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the levels of the',&
+        & 'grid need to be provided to restini. This',&
+        & 'information is needed for the restart files')
+    ENDIF
+!---
+!-- 2.2 Allocate the time axes and write the inputed variables
+!---
+    tax_size_in(nb_fi) = 1
+    CALL rest_atim (l_dbg,'restini')
+    t_index(nb_fi,1) = itau
+    t_julian(nb_fi,1) = date0
+  ENDIF
+!-
+  IF (l_fo.AND.(.NOT.l_rw)) THEN
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnameout
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenout &
+      (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id)
+    netcdf_id(nb_fi,2) = ncfid
+  ELSE IF (l_fi.AND.l_fo) THEN
+    netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1)
+    varname_out(nb_fi,:) = varname_in(nb_fi,:)
+    nbvar_out(nb_fi) = nbvar_in(nb_fi)
+    tind_varid_out(nb_fi) = tind_varid_in(nb_fi)
+    tax_varid_out(nb_fi) = tax_varid_in(nb_fi)
+    varid_out(nb_fi,:) = varid_in(nb_fi,:)
+    touched_out(nb_fi,:) = .TRUE.
+  ENDIF
+!-
+! 2.3 Set the calendar for the run.
+!     This should not produce any error message if
+!     This does not mean any change in calendar
+!     (to be modified in ioconf_calendar)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', &
+                calend_str
+  ENDIF
+!-
+  IF (INDEX(calend_str,'unknown') < 1) THEN
+    CALL ioconf_calendar (calend_str)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str
+    ENDIF
+  ENDIF
+!-
+! Save some data in the module
+!-
+  deltat(nb_fi) = dt
+!-
+! Prepare the variables which will be returned
+!-
+  fid = nb_fi
+  IF (l_dbg) THEN
+    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), &
+               SIZE(t_index,dim=1),SIZE(t_index,dim=2)
+    WRITE(*,*) 't_index = ',t_index(fid,:)
+  ENDIF
+  itau = t_index(fid,1)
+!-
+  IF (l_dbg) WRITE(*,*) 'restini END'
+!---------------------
+END SUBROUTINE restini
+!===
+SUBROUTINE restopenin &
+  (fid,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+!---------------------------------------------------------------------
+!- Opens the restart file and checks that it belongsd to the model.
+!- This means that the coordinates of the model are compared to the
+!- ones in the file.
+!-
+!- The number and name of variable in the file are exctracted. Also
+!- the time details.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*),INTENT(IN) :: fname
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  LOGICAL,INTENT(IN) :: l_rw
+  INTEGER,INTENT(OUT) :: ncfid
+!-
+  INTEGER,DIMENSION(max_dim) :: var_dims,dimlen
+  INTEGER :: nb_dim,nb_var,id_unl,id,iv
+  INTEGER :: iread,jread,lread,iret
+  INTEGER :: lon_vid,lat_vid
+  REAL :: lon_read(iim,jjm),lat_read(iim,jjm)
+  REAL :: lev_read(llm)
+  REAL :: mdlon,mdlat
+  CHARACTER(LEN=80) :: units
+  CHARACTER(LEN=NF90_max_name),DIMENSION(max_dim) :: dimname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! If we reuse the same file for input and output
+! then we open it in write mode
+!-
+  IF (l_rw) THEN; id = NF90_WRITE; ELSE; id = NF90_NOWRITE; ENDIF
+  iret = NF90_OPEN(fname,id,ncfid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restopenin','Could not open file :',fname,' ')
+  ENDIF
+!-
+  IF (l_dbg) WRITE (*,*) "restopenin 0.0 ",TRIM(fname)
+  iret = NF90_INQUIRE(ncfid,nDimensions=nb_dim, &
+ &         nVariables=nb_var,unlimitedDimId=id_unl)
+  tdimid_in(fid) = id_unl
+!-
+  IF (nb_dim > max_dim) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More dimensions present in file that can be store',&
+      & 'Please increase max_dim in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+  IF (nb_var > max_var) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More variables present in file that can be store',&
+      & 'Please increase max_var in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+!-
+  nbvar_in(fid) = nb_var
+  nbdim_in(fid) = nb_dim
+  iread = -1; jread = -1; lread = -1;
+  DO id=1,nb_dim
+    iret = NF90_INQUIRE_DIMENSION(ncfid,id, &
+ &           len=dimlen(id),name=dimname(id))
+    IF (l_dbg) THEN
+      WRITE (*,*) "restopenin 0.0 dimname",id,TRIM(dimname(id))
+    ENDIF
+    IF      (TRIM(dimname(id)) == 'x') THEN
+      iread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "iread",iread
+    ELSE IF (TRIM(dimname(id)) == 'y') THEN
+      jread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "jread",jread
+    ELSE IF (TRIM(dimname(id)) == 'z') THEN
+      lread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "lread",lread
+    ENDIF
+  ENDDO
+!-
+  IF (id_unl > 0) THEN
+!---
+!-- 0.1 If we are going to add values to this file
+!--     we need to know where it ends
+!--     We also need to have all the dimensions in the file
+!---
+    IF (l_rw) THEN
+      tstp_out(fid) = dimlen(id_unl)
+      itau_out(fid) = -1
+      tdimid_out(fid) =  tdimid_in(fid)
+      IF (l_dbg) THEN
+        WRITE (*,*) &
+ &       "restopenin 0.0 unlimited axis dimname", &
+ &       dimname(id_unl),tstp_out(fid)
+      ENDIF
+!-----
+      xax_nb(fid) = 0
+      yax_nb(fid) = 0
+      zax_nb(fid) = 0
+!-----
+      DO id=1,nb_dim
+        IF      (dimname(id)(1:1) == 'x') THEN
+          xax_nb(fid) = xax_nb(fid)+1
+          xax_infs(fid,xax_nb(fid),1) = dimlen(id)
+          xax_infs(fid,xax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'y') THEN
+          yax_nb(fid) = yax_nb(fid)+1
+          yax_infs(fid,yax_nb(fid),1) = dimlen(id)
+          yax_infs(fid,yax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'z') THEN
+          zax_nb(fid) = zax_nb(fid)+1
+          zax_infs(fid,zax_nb(fid),1) = dimlen(id)
+          zax_infs(fid,zax_nb(fid),2) = id
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+!---
+!-- Still need to find a method for dealing with this
+!---
+!  CALL ipslerr (3,'restopenin',&
+!    & ' We do not deal yet with files without time axis.',' ',' ')
+  ENDIF
+!-
+! 1.0 First let us check that we have the righ restart file
+!-
+  IF ((iread /= iim).OR.(jread /= jjm).OR.(lread /= llm)) THEN
+    CALL ipslerr (3,'restopenin',&
+ &    'The grid of the restart file does not correspond',&
+ &    'to that of the model',' ')
+  ENDIF
+!-
+! 2.0 Get the list of variables
+!-
+  IF (l_dbg) WRITE(*,*) 'restopenin 1.2'
+!-
+  lat_vid = -1
+  lon_vid = -1
+  tind_varid_in(fid) = -1
+  tax_varid_in(fid) = -1
+!-
+  DO iv=1,nb_var
+!---
+    varid_in(fid,iv) = iv
+    var_dims(:) = 0
+    iret = NF90_INQUIRE_VARIABLE(ncfid,iv, &
+ &           name=varname_in(fid,iv),xtype=vartyp_in(fid,iv), &
+ &           ndims=varnbdim_in(fid,iv),dimids=var_dims, &
+ &           nAtts=varatt_in(fid,iv))
+!---
+    DO id=1,varnbdim_in(fid,iv)
+      iret = NF90_INQUIRE_DIMENSION &
+ &             (ncfid,var_dims(id),len=vardims_in(fid,iv,id))
+    ENDDO
+!---
+!-- 2.1 Read the units of the variable
+!---
+    units=''
+    iret = NF90_GET_ATT(ncfid,iv,'units',units)
+    CALL strlowercase (units)
+    CALL cmpblank (units)
+!---
+!-- 2.2 Catch the time variables
+!---
+    IF (varnbdim_in(fid,iv) == 1) THEN
+      IF (     (INDEX(units,'timesteps since') > 0) &
+          .AND.(tind_varid_in(fid) < 0) ) THEN
+        tind_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+      IF (     (INDEX(units,'seconds since') > 0) &
+          .AND.(tax_varid_in(fid) < 0) ) THEN
+        tax_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+    ENDIF
+!---
+!-- 2.3 Catch longitude and latitude variables
+!---
+    IF      (INDEX(units,'degrees_nort') > 0) THEN
+      lat_vid = iv
+    ELSE IF (INDEX(units,'degrees_east') > 0) THEN
+      lon_vid = iv
+    ENDIF
+!---
+  ENDDO
+!-
+! 2.4 None of the variables was yet read
+!-
+  nbvar_read(fid) = 0
+  touched_in(fid,:) = .FALSE.
+!-
+! 3.0 Reading the coordinates from the input restart file
+!-
+  lon_read = missing_val
+  lat_read = missing_val
+!-
+  IF (lon_vid < 0 .OR. lat_vid < 0) THEN
+    CALL ipslerr (3,'restopenin',&
+      & ' No variables containing longitude or latitude were ',&
+      & ' found in the restart file.',' ')
+  ELSE
+    iret = NF90_GET_VAR(ncfid,lon_vid,lon_read)
+    iret = NF90_GET_VAR(ncfid,lat_vid,lat_read)
+!---
+    IF (  (ABS( MAXVAL(lon(:,:)) &
+ &             -MINVAL(lon(:,:))) < EPSILON(MAXVAL(lon(:,:)))) &
+ &   .AND.(ABS( MAXVAL(lat(:,:)) &
+ &             -MINVAL(lat(:,:))) < EPSILON(MAXVAL(lat(:,:)))) ) THEN
+!-----
+!---- 3.1 No longitude nor latitude are provided thus
+!---- they are taken from the restart file
+!-----
+      lon(:,:) = lon_read(:,:)
+      lat(:,:) = lat_read(:,:)
+    ELSE
+!-----
+!---- 3.2 We check that the longitudes and latitudes
+!----     in the file and the model are the same
+!-----
+      mdlon = MAXVAL(ABS(lon_read-lon))
+      mdlat = MAXVAL(ABS(lat_read-lat))
+!-----
+!---- We can not test against epsilon here as the longitude
+!---- can be stored at another precision in the netCDF file.
+!---- The test here does not need to be very precise.
+!-----
+      IF (mdlon > 1.e-4 .OR. mdlat > 1.e-4) THEN
+        CALL ipslerr (3,'restopenin',&
+          & ' The longitude or latitude found in the restart ',&
+          & ' file are not the same as the ones used in the model.',&
+          & ' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE restopenin
+!===
+SUBROUTINE restsett (timestep,date0,itau,owrite_time_in)
+!---------------------------------------------------------------------
+!- Here we get all the time information from the file.
+!-
+!- The time information can come in three forms :
+!- -global attributes which give the time origine and the
+!-  time step is taken from the input to restinit
+!- -A physical time exists and thus the julian date from the
+!-  input is used for positioning using the itau as input
+!- -A time-step axis exists and itau is positioned on it.
+!-
+!- What takes precedence : the model
+!-
+!- itau     : Time step of the model
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: date0,timestep
+  INTEGER :: itau
+  LOGICAL,OPTIONAL :: owrite_time_in
+!-
+  INTEGER :: ncfid,iret,it,iax,iv
+  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar
+  CHARACTER(LEN=9) :: tmp_cal
+  INTEGER :: year0,month0,day0,hours0,minutes0,seci
+  REAL :: sec0,one_day,one_year,date0_ju,ttmp
+  CHARACTER :: strc
+  LOGICAL :: ow_time
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(owrite_time_in)) THEN
+    ow_time = owrite_time_in
+  ELSE
+    ow_time = .FALSE.
+  ENDIF
+!-
+  ncfid = netcdf_id(nb_fi,1)
+!-
+! Allocate the space we need for the time axes
+!-
+  CALL rest_atim (l_dbg,'restsett')
+!-
+! Get the calendar if possible. Else it will be gregorian.
+!-
+  IF (tax_size_in(nb_fi) > 0) THEN
+    calendar = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar (calendar)
+      IF (l_dbg) THEN
+        WRITE(*,*) 'restsett : calendar of the restart ',calendar
+      ENDIF
+    ENDIF
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+  IF (l_dbg) THEN
+    WRITE(*,*) 'one_year,one_day = ',one_year,one_day
+  ENDIF
+!-
+  itau_orig = 'XXXXX'
+  tax_orig  = 'XXXXX'
+!-
+! Get the time steps of the time axis if available on the restart file
+!-
+  IF (tind_varid_in(nb_fi) > 0) THEN
+    IF (ow_time) THEN
+      t_index(nb_fi,:) = itau
+      IF (l_dbg) THEN
+        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)
+      ENDIF
+      CALL ju2ymds (date0,year0,month0,day0,sec0)
+      hours0 = NINT(sec0/3600)
+      sec0 = sec0 - 3600 * hours0
+      minutes0 = NINT(sec0 / 60)
+      sec0 = sec0 - 60 * minutes0
+      seci = NINT(sec0)
+      strc=':'
+      IF (l_dbg) THEN
+        WRITE(*,*) date0
+        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci
+        WRITE(*,*) "itau_orig : ",itau_orig
+      ENDIF
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      IF (l_dbg) THEN
+        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:)
+      ENDIF
+      iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig)
+      itau_orig = &
+ &      itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig))
+      iret = &
+ &      NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'tstep_sec',timestep)
+!-----
+!---- This time origin will dominate as it is linked to the time steps.
+!-----
+      READ (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &      year0,strc,month0,strc,day0,strc, &
+ &      hours0,strc,minutes0,strc,seci
+      sec0 = REAL(seci)
+      sec0 = hours0*3600.+minutes0*60.+sec0
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+    ENDIF
+  ENDIF
+!-
+! If a julian day time axis is available then we get it
+!-
+  IF (tax_varid_in(nb_fi) > 0) THEN
+    iret = NF90_GET_VAR(ncfid,tax_varid_in(nb_fi),t_julian(nb_fi,:))
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'units',tax_orig)
+    tax_orig = tax_orig(INDEX(tax_orig,'since')+6:LEN_TRIM(tax_orig))
+    tmp_cal = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal
+    ENDIF
+!---
+    CALL strlowercase (tmp_cal)
+    IF (INDEX(calend_str,tmp_cal) < 1) THEN
+      IF (INDEX(calend_str,'unknown') > 0) THEN
+        calend_str = tmp_cal
+      ELSE
+        CALL ipslerr (2,'restsett', &
+ &       ' In the restart files two different calendars were found.', &
+ &       ' Please check the files you have used.',' ')
+      ENDIF
+    ENDIF
+!---
+!-- We need to transform that into julian days
+!-- to get ride of the intial date.
+!---
+    IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig)
+    READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') &
+      year0,strc,month0,strc,day0,strc, &
+      hours0,strc,minutes0,strc,seci
+    sec0 = REAL(seci)
+    sec0 = hours0*3600.+minutes0*60.+sec0
+    CALL ymds2ju (year0,month0,day0,sec0,date0_ju)
+    t_julian(nb_fi,:) = t_julian(nb_fi,:)/one_day+date0_ju
+  ENDIF
+!-
+  IF (     (INDEX(itau_orig,'XXXXX') > 0) &
+      .AND.(INDEX(tax_orig,'XXXXX')  < 1) ) THEN
+!!- Compute the t_itau from the date read and the timestep in the input
+  ENDIF
+!-
+  IF (     (INDEX(tax_orig,'XXXXX')  > 0) &
+      .AND.(INDEX(itau_orig,'XXXXX') < 1) ) THEN
+    DO it=1,tax_size_in(nb_fi)
+      t_julian(nb_fi,it) = itau2date(t_index(nb_fi,it),date0,timestep)
+    ENDDO
+  ENDIF
+!-
+! If neither the indices or time is present then get global attributes
+! This is for compatibility reasons and should not be used.
+!-
+  IF ((tax_varid_in(nb_fi) < 0).AND.(tind_varid_in(nb_fi) < 0)) THEN
+    iax = -1
+    DO iv=1,nbvar_in(nb_fi)
+      IF (    (INDEX(varname_in(nb_fi,iv),'tsteps') > 0) &
+ &        .OR.(INDEX(varname_in(nb_fi,iv),'time_steps') > 0)) THEN
+        iax = iv
+      ENDIF
+    ENDDO
+!---
+    IF (iax < 0) THEN
+      CALL ipslerr (3,'restsett',&
+        & 'No time axis was found in the restart file. Please check',&
+        & 'that it corresponds to the convention used in restsett',&
+        & ' ')
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'delta_tstep_sec',timestep)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'year0',ttmp)
+      year0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'month0',ttmp)
+      month0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'day0',ttmp)
+      day0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'sec0',sec0)
+!---
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+      t_julian(nb_fi,1) = itau2date(t_index(nb_fi,1),date0,timestep)
+    ENDIF
+  ENDIF
+!----------------------
+END SUBROUTINE restsett
+!===
+SUBROUTINE restopenout &
+  (fid,fname,iim,jjm, &
+   lon,lat,llm,lev,timestep,date,ncfid,domain_id)
+!---------------------------------------------------------------------
+!- Opens the restart file for output.
+!- The longitude and time variables are written.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*) :: fname
+  REAL :: date,timestep
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  INTEGER,INTENT(OUT) :: ncfid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: iret
+  CHARACTER(LEN=70) :: str_t
+  INTEGER :: x_id,y_id,z_id,itauid
+  INTEGER :: nlonid,nlatid,nlevid,timeid
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  CHARACTER(LEN=3),DIMENSION(12) :: &
+    cal = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+            'JUL','AUG','SEP','OCT','NOV','DEC'/)
+  CHARACTER(LEN=30) :: timenow
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname)
+!-
+!  If we use the same file for input and output
+!- we will not even call restopenout
+!-
+  iret = NF90_CREATE(fname,NF90_NOCLOBBER,ncfid)
+  IF (iret == -35) THEN
+    CALL ipslerr (3,'restopenout',&
+      & ' The restart file aready exists on the disc. IOIPSL ',&
+      & ' will not overwrite it. You should remove the old one or ',&
+      & ' generate the new one with another name')
+  ENDIF
+!-
+  iret = NF90_DEF_DIM(ncfid,'x',iim,x_id)
+  xax_nb(fid) = xax_nb(fid)+1
+  xax_infs(fid,xax_nb(fid),1) = iim
+  xax_infs(fid,xax_nb(fid),2) = x_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'y',jjm,y_id)
+  yax_nb(fid)  = yax_nb(fid)+1
+  yax_infs(fid,yax_nb(fid),1) = jjm
+  yax_infs(fid,yax_nb(fid),2) = y_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'z',llm,z_id)
+  zax_nb(fid) = zax_nb(fid)+1
+  zax_infs(fid,zax_nb(fid),1) = llm
+  zax_infs(fid,zax_nb(fid),2) = z_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'time',NF90_UNLIMITED,tdimid_out(fid))
+!-
+! 1.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 1.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid)
+  iret = NF90_PUT_ATT(ncfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_min',REAL(-180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_max',REAL( 180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'long_name',"Longitude")
+!-
+! 2.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 2.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid)
+  iret = NF90_PUT_ATT(ncfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_min',REAL(-90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_max',REAL( 90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'long_name',"Latitude")
+!-
+! 3.0 Levels
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 3.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid)
+  iret = NF90_PUT_ATT(ncfid,nlevid,'units',"model_levels")
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_min', &
+ &                     REAL(MINVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_max', &
+ &                     REAL(MAXVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'long_name',"Model levels")
+!-
+! 4.0 Time axis, this is the seconds since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 4.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, &
+                       tdimid_out(fid),timeid)
+  tax_varid_out(fid) = timeid
+!-
+  timeorig(fid) = date
+  CALL ju2ymds (date,year,month,day,sec)
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+  WRITE (UNIT=str_t, &
+   FMT='("seconds since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'units',TRIM(str_t))
+!-
+  CALL ioget_calendar (str_t)
+  iret = NF90_PUT_ATT(ncfid,timeid,'calendar',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,timeid,'title','Time')
+  iret = NF90_PUT_ATT(ncfid,timeid,'long_name','Time axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'time_origin',TRIM(str_t))
+!-
+! 5.0 Time axis, this is the time steps since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 5.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, &
+ &                    tdimid_out(fid),itauid)
+  tind_varid_out(fid) = itauid
+!-
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+!-
+  WRITE (UNIT=str_t, &
+   FMT='("timesteps since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+!-
+  iret = NF90_PUT_ATT(ncfid,itauid,'units',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,itauid,'title','Time steps')
+  iret = NF90_PUT_ATT(ncfid,itauid,'tstep_sec',REAL(timestep,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,itauid,'long_name','Time step axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,itauid,'time_origin',TRIM(str_t))
+!-
+!  5.2 Write global attributes
+!-
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'Conventions',"CF-1.1")
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'file_name',TRIM(fname))
+!!  TO BE DONE LATER
+!!   iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL, &
+!!                       'production',TRIM(model_name))
+!!   lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! Add DOMAIN attributes if needed
+!-
+  CALL flio_dom_att (ncfid,domain_id)
+!-
+! 6.0 The coordinates are written to the file
+!-
+  iret = NF90_ENDDEF(ncfid)
+!-
+  iret = NF90_PUT_VAR(ncfid,nlonid,lon)
+  iret = NF90_PUT_VAR(ncfid,nlatid,lat)
+  iret = NF90_PUT_VAR(ncfid,nlevid,lev)
+!-
+! 7.0 Set a few variables related to the out file
+!-
+  nbvar_out(fid) = 0
+  itau_out(fid) = -1
+  tstp_out(fid) = 0
+  touched_out(fid,:) = .FALSE.
+!-
+! 7.1 The file is put back in define mode.
+!     This will last until itau_out >= 0
+!-
+  iret = NF90_REDEF(ncfid)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout END"
+!-------------------------
+END SUBROUTINE restopenout
+!===
+SUBROUTINE restget_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r1d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'Unable to performe an operation on this variable as it has',&
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restget_opp_r1d')
+!-
+! 2.0 Here we get the variable from the restart file
+!-
+  CALL restget_real &
+    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+     zax_infs(fid,1,1),itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    CALL mathop (topp,req_sz,buff_tmp2,missing_val, &
+ &               nbindex,ijndex,scal,siz1,buff_tmp1)
+    var(:) = buff_tmp1(1:siz1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r1d
+!===
+SUBROUTINE restget_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r2d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,var_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim  .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restget_opp_r2d')
+!-
+! 2.0 Here we get the full variable from the restart file
+!-
+  CALL restget_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    var_sz = siz1
+    DO jj = 1,jjm
+      ist = (jj-1)*req_sz+1
+      CALL mathop (topp,req_sz,buff_tmp2(ist:ist+req_sz-1), &
+ &      missing_val,nbindex,ijndex,scal,var_sz,buff_tmp1)
+      var(:,jj) = buff_tmp1(1:siz1)
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r2d
+!===
+SUBROUTINE restget_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable requested from file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("the size of variable requested from file is ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    var(ji) = buff_tmp1(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r1d
+!===
+SUBROUTINE restget_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r2d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      var(ji,jj) = buff_tmp1(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r2d
+!===
+SUBROUTINE restget_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r3d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+    (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp1(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r3d
+!===
+SUBROUTINE restget_real &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine is for getting a variable from the restart file.
+!- A number of verifications will be made :
+!- - Is this the first time we read this variable ?
+!- - Are the dimensions correct ?
+!- - Is the correct time step present in the file
+!- - is a default behaviour possible. If not the model is stoped.
+!- Default procedure is to write the content of val_exp on all values.
+!-
+!- INPUT
+!-
+!- fid            : Identification of the file
+!- vname_q        : Name of the variable to be read
+!- iim, jjm ,llm  : Dimensions of the variable that should be read
+!- itau           : Time step at whcih we are when we want
+!-                  to read the variable
+!- def_beha       : If the model can restart without this variable
+!-                  then some strange value is given.
+!-
+!- OUTPUT
+!-
+!- var            : Variable in which the data is put
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: vid,vnb,ncfid,iret,index,it,ndim,ia
+  CHARACTER(LEN=70) str,str2
+  CHARACTER(LEN=80) attname
+  INTEGER,DIMENSION(4) :: corner,edge
+!---------------------------------------------------------------------
+  ncfid = netcdf_id(fid,1)
+!-
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+! 1.0 If the variable is not present then ERROR or filled up
+!     by default values if allowed
+!-
+  IF (vnb < 0) THEN
+    IF (def_beha) THEN
+!-----
+      lock_valexp = .TRUE.
+      var(:) = val_exp
+!----
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (1,'restget', &
+ &      str,'but default values are used to fill in',' ')
+!----
+      IF (nbvar_in(fid) >= max_var) THEN
+        CALL ipslerr (3,'restget', &
+         'Too many variables for the restcom module', &
+         'Please increase the value of max_var',' ')
+      ENDIF
+      nbvar_in(fid) = nbvar_in(fid)+1
+      vnb = nbvar_in(fid)
+      varname_in(fid,vnb) = vname_q
+      touched_in(fid,vnb) = .TRUE.
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+!-----
+    ELSE
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (3,'restget', &
+ &      str,'but it is need to restart the model',' ')
+    ENDIF
+!---
+  ELSE
+!---
+!--  2.0 Check if the variable has not yet been read
+!--      and that the time is OK
+!---
+    vid = varid_in(fid,vnb)
+!---
+    nbvar_read(fid) = nbvar_read(fid)+1
+!---
+    IF (touched_in(fid,vnb)) THEN
+      str = 'Variable '//TRIM(vname_q) &
+          //' has already been read from file'
+      CALL ipslerr (3,'restget',str,' ',' ')
+    ENDIF
+!---
+!-- 3.0 get the time step of the restart file
+!--     and check if it is correct
+!---
+    index = -1
+    DO it=1,tax_size_in(fid)
+      IF (t_index(fid,it) == itau)  index = it
+    ENDDO
+    IF (index < 0) THEN
+      str = 'The time step requested for variable '//TRIM(vname_q)
+      CALL ipslerr (3,'restget', &
+ &      str,'is not available in the current file',' ')
+    ENDIF
+!---
+!-- 4.0 Read the data. Note that the variables in the restart files
+!--     have no time axis is and thus we write -1
+!---
+    str='Incorrect dimension for '//TRIM(vname_q)
+    ndim = 0
+    IF (iim > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == iim) THEN
+        corner(ndim) = 1
+        edge(ndim) = iim
+      ELSE
+        WRITE (str2,'("Incompatibility for iim : ",I6,I6)') &
+             iim,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (jjm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == jjm) THEN
+        corner(ndim) = 1
+        edge(ndim) = jjm
+      ELSE
+        WRITE (str2,'("Incompatibility for jjm : ",I6,I6)') &
+             jjm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == llm) THEN
+        corner(ndim) = 1
+        edge(ndim) = llm
+      ELSE
+        WRITE (str2,'("Incompatibility for llm : ",I6,I6)') &
+             llm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+!-- Time
+!---
+    ndim = ndim+1
+    corner(ndim) = index
+!!????? edge(ndim) = index
+    edge(ndim) = 1
+!---
+    iret = NF90_GET_VAR(ncfid,vid,var, &
+ &                      start=corner(1:ndim),count=edge(1:ndim))
+!---
+!-- 5.0 The variable we have just read is created
+!--      in the next restart file
+!---
+    IF (     (netcdf_id(fid,1) /= netcdf_id(fid,2))  &
+ &      .AND.(netcdf_id(fid,2) > 0) ) THEN
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.FALSE.)
+!-----
+      DO ia = 1,varatt_in(fid,vnb)
+        iret = NF90_INQ_ATTNAME(ncfid,vid,ia,attname)
+        iret = NF90_COPY_ATT(ncfid,vid,attname, &
+ &               netcdf_id(fid,2),varid_out(fid,nbvar_out(fid)))
+      ENDDO
+!-----
+      IF (itau_out(fid) >= 0) THEN
+        iret = NF90_ENDDEF(netcdf_id(fid,2))
+      ENDIF
+    ENDIF
+!---
+  ENDIF
+!--------------------------
+END SUBROUTINE restget_real
+!===
+SUBROUTINE restput_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project a vector back onto the original 2D or 3D field.
+!- This requires that jjm and llm be equal to 1 or 0,
+!- else I would not know what it means.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restput_opp_r1d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    buff_tmp1(1:siz1) = var(:)
+    CALL mathop &
+ &    (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &     scal,req_sz,buff_tmp2)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  zax_infs(fid,1,1),itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r1d
+!===
+SUBROUTINE restput_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project the first dimension of the matrix back onto a 3D field
+!- where jjm will be the third dimension.
+!- Here we do not allow for 4D data, thus we will take the first
+!- two dimensions in the file and require that llm = 1.
+!- These are pretty heavy constraints but I do not know how
+!- to make it more general. I need to think about it some more.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restput_opp_r2d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    DO jj = 1,jjm
+      buff_tmp1(1:siz1) = var(:,jj)
+      ist = (jj-1)*req_sz+1
+      CALL mathop &
+ &      (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &       scal,req_sz,buff_tmp2(ist:ist+req_sz-1))
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r2d
+!===
+SUBROUTINE restput_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size ",I6)') var_sz
+    CALL ipslerr (3,'restput_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)') var_sz
+    CALL ipslerr (2,'restput_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    buff_tmp1(jl) = var(ji)
+  ENDDO
+!-
+  CALL restput_real (fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r1d
+!===
+SUBROUTINE restput_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r2d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+&         '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is of size  ",I6)') var_sz
+    CALL ipslerr (3,'restput_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      buff_tmp1(jl) = var(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r2d
+!===
+SUBROUTINE restput_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r3d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size  ",I6)')  var_sz
+    CALL ipslerr (3,'restput_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        buff_tmp1(jl) = var(ji,jj,jk)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r3d
+!===
+SUBROUTINE restput_real (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine will put a variable into the restart file.
+!- But it will do a lot of other things if needed :
+!- - Open a file if non is opened for this time-step
+!-   and all variables were written.
+!- - Add an axis if needed
+!- - verify that the variable has the right time step for this file
+!- - If it is time for a new file then it is opened
+!-   and the old one closed
+!- This requires that variables read from the last restart file were all
+!- written
+!-
+!- INPUT
+!-
+!- fid         : Id of the file in which we will write the variable
+!- vname_q     : Name of the variable to be written
+!- iim,jjm,llm : Size in 3D of the variable
+!- itau        : Time step at which the variable is written
+!- var         : Variable
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: fid,iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: iret,vid,ncid,iv,vnb
+  INTEGER :: ierr
+  REAL :: secsince,one_day,one_year
+  INTEGER :: ndims
+  INTEGER,DIMENSION(4) :: corner,edge
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Get some variables
+!-
+  ncid = netcdf_id(fid,2)
+  IF (netcdf_id(fid,2) < 0) THEN
+    CALL ipslerr (3,'restput', &
+ &    'The output restart file is undefined.',' ',' ')
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+!-
+! 1.0 Check if the variable is already present
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
+!-
+  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb
+  ENDIF
+!-
+! 2.0 If variable is not present then declare it
+!     and add extra dimensions if needed.
+!-
+  IF (vnb <= 0) THEN
+    CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+    vnb = nbvar_out(fid)
+  ENDIF
+  vid = varid_out(fid,vnb)
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid
+!-
+! 2.1 Is this file already in write mode ?
+!     If itau_out is still negative then we have
+!     never written to it and we need to go into write mode.
+!-
+  IF (itau_out(fid) < 0) THEN
+    iret = NF90_ENDDEF(ncid)
+  ENDIF
+!-
+! 3.0 Is this itau already on the axis ?
+!     If not then check that all variables of previous time is OK.
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)
+!-
+  IF (itau /= itau_out(fid)) THEN
+!---
+!-- If it is the first time step written on the restart
+!-- then we only check the number
+!-- Else we see if every variable was written
+!---
+    IF (tstp_out(fid) == 0) THEN
+      IF (nbvar_out(fid) < nbvar_read(fid)) THEN
+        WRITE(*,*) "ERROR :",tstp_out(fid), &
+                   nbvar_out(fid),nbvar_read(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables read from the output file', &
+ &        'than written onto the input file.', &
+ &        'We trust you know what you are doing')
+      ENDIF
+    ELSE
+      ierr = 0
+      DO iv=1,nbvar_out(fid)
+        IF (.NOT.touched_out(fid,iv)) ierr = ierr+1
+      ENDDO
+      IF (ierr > 0) THEN
+        WRITE(*,*) "ERROR :",nbvar_out(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables in the output file for this', &
+ &        'time step than for the previous one',' ')
+      ELSE
+        touched_out(fid,:) = .FALSE.
+      ENDIF
+    ENDIF
+!---
+    secsince = itau*deltat(fid)
+    corner(1) =  tstp_out(fid)+1
+    edge(1) = 1
+!---
+!-- 3.1 Here we add the values to the time axes
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)
+    ENDIF
+!---
+    iret = NF90_PUT_VAR(ncid,tind_varid_out(fid),itau, &
+ &                      start=corner(1:1))
+    iret = NF90_PUT_VAR(ncid,tax_varid_out(fid),secsince, &
+ &                      start=corner(1:1))
+!---
+    tstp_out(fid) = tstp_out(fid)+1
+    itau_out(fid) = itau
+  ENDIF
+!-
+! 4.0 Variable and time step should be present
+!     now so we can dump variable
+!-
+  ndims = 0
+  IF (iim > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = iim
+  ENDIF
+  IF (jjm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = jjm
+  ENDIF
+  IF (llm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = llm
+  ENDIF
+  ndims = ndims+1
+  corner(ndims) = tstp_out(fid)
+  edge(ndims) = 1
+!-
+  iret = NF90_PUT_VAR(ncid,vid,var, &
+ &                    start=corner(1:ndims),count=edge(1:ndims))
+!-
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (2,'restput_real',NF90_STRERROR(iret), &
+ &    'Bug in restput.',&
+ &    'Please, verify compatibility between get and put commands.')
+  ENDIF
+!-
+!  5.0 Note that the variables was treated
+!-
+  touched_out(fid,vnb) = .TRUE.
+!---------------------------
+END  SUBROUTINE restput_real
+!===
+SUBROUTINE restdefv (fid,varname,iim,jjm,llm,write_att)
+!---------------------------------------------------------------------
+! This subroutine adds a variable to the output file.
+! The attributes are either taken from.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER ::fid
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm
+  LOGICAL :: write_att
+!-
+  INTEGER :: dims(4),ic,xloc,ndim,ncfid
+  INTEGER :: iret,ax_id
+  CHARACTER(LEN=3) :: str
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ncfid = netcdf_id(fid,2)
+  IF (nbvar_out(fid) >= max_var) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Too many variables for the restcom module', &
+      'Please increase the value of max_var',' ')
+  ENDIF
+  nbvar_out(fid) = nbvar_out(fid)+1
+  varname_out(fid,nbvar_out(fid)) = varname
+!-
+! 0.0 Put the file in define mode if needed
+!-
+  IF (itau_out(fid) >= 0) THEN
+    iret = NF90_REDEF(ncfid)
+  ENDIF
+!-
+! 1.0 Do we have all dimensions and can we go ahead
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)
+  ENDIF
+!-
+  ndim = 0
+!-
+! 1.1 Work on x
+!-
+  IF (iim > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,xax_nb(fid)
+      IF (xax_infs(fid,ic,1) == iim) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = xax_infs(fid,xloc,2)
+    ELSE
+      str='x_'//CHAR(96+xax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,iim,ax_id)
+      xax_nb(fid) = xax_nb(fid)+1
+      xax_infs(fid,xax_nb(fid),1) = iim
+      xax_infs(fid,xax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.2 Work on y
+!-
+  IF (jjm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,yax_nb(fid)
+      IF (yax_infs(fid,ic,1) == jjm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = yax_infs(fid,xloc,2)
+    ELSE
+      str='y_'//CHAR(96+yax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,jjm,ax_id)
+      yax_nb(fid) = yax_nb(fid)+1
+      yax_infs(fid,yax_nb(fid),1) = jjm
+      yax_infs(fid,yax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.3 Work on z
+!-
+  IF (llm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,zax_nb(fid)
+      IF (zax_infs(fid,ic,1) == llm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = zax_infs(fid,xloc,2)
+    ELSE
+      str='z_'//CHAR(96+zax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,llm,ax_id)
+      zax_nb(fid) = zax_nb(fid)+1
+      zax_infs(fid,zax_nb(fid),1) = llm
+      zax_infs(fid,zax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.4  Time needs to be added
+!-
+  ndim = ndim+1
+  dims(ndim) = tdimid_out(fid)
+!-
+! 2.0  Declare the variable
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)
+  ENDIF
+!-
+  iret = NF90_DEF_VAR(ncfid,varname,NF90_DOUBLE,dims(1:ndim), &
+ &                    varid_out(fid,nbvar_out(fid)))
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Could not define new variable in file', &
+      NF90_STRERROR(iret),varname)
+  ENDIF
+!-
+! 3.0 Add the attributes if requested
+!-
+  IF (write_att) THEN
+    IF (rest_units /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'units',TRIM(rest_units))
+      rest_units = 'XXXXX'
+    ENDIF
+!---
+    IF (rest_lname /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'long_name',TRIM(rest_lname))
+      rest_lname = 'XXXXX'
+    ENDIF
+!---
+    iret = NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                      'missing_value',REAL(missing_val,KIND=4))
+!---
+    IF (itau_out(fid) >= 0) THEN
+      iret = NF90_ENDDEF(ncfid)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid))
+  ENDIF
+!----------------------
+END SUBROUTINE restdefv
+!===
+SUBROUTINE rest_atim (l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", [re]allocate the time axes
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_err,tszij
+  INTEGER,ALLOCATABLE :: tmp_index(:,:)
+  REAL,ALLOCATABLE :: tmp_julian(:,:)
+!---------------------------------------------------------------------
+!-
+!  Allocate the space we need for the time axes
+!-
+  IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of t_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_index (:,:) = 0
+!---
+    ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of max_file,tax_size_in','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian (:,:) = 0.0
+  ELSE IF (    (SIZE(t_index,DIM=2)  < tax_size_in(nb_fi)) &
+ &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of tmp_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_index,DIM=2)
+    tmp_index(:,1:tszij) = t_index(:,1:tszij)
+    DEALLOCATE(t_index)
+    ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in reallocation of t_index','', &
+ &     '(you must increase memory)')
+    ENDIF
+    t_index(:,1:tszij) = tmp_index(:,1:tszij)
+!---
+    ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in allocation of tmp_julian','', &
+ &     '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_julian,DIM=2)
+    tmp_julian(:,1:tszij) = t_julian(:,1:tszij)
+    DEALLOCATE(t_julian)
+    ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in reallocation of t_julian','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian(:,1:tszij) = tmp_julian(:,1:tszij)
+  ENDIF
+!-----------------------
+END SUBROUTINE rest_atim
+!===
+SUBROUTINE rest_alloc (i_buff,i_qsz,l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", allocate a temporary buffer
+! (buff_tmp[1/2] depending on "i_buff" value) to the size "i_qsz".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_buff,i_qsz
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_bsz,i_err
+  LOGICAL :: l_alloc1,l_alloc2
+  CHARACTER(LEN=9) :: cbn
+  CHARACTER(LEN=5) :: c_err
+!---------------------------------------------------------------------
+  IF      (i_buff == 1) THEN
+    IF (ALLOCATED(buff_tmp1)) THEN
+      i_bsz = SIZE(buff_tmp1)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 =    (.NOT.ALLOCATED(buff_tmp1)) &
+ &            .OR.((ALLOCATED(buff_tmp1)).AND.(i_qsz > i_bsz))
+    l_alloc2 = .FALSE.
+    cbn = 'buff_tmp1'
+  ELSE IF (i_buff == 2) THEN
+    IF (ALLOCATED(buff_tmp2)) THEN
+      i_bsz = SIZE(buff_tmp2)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 = .FALSE.
+    l_alloc2 =    (.NOT.ALLOCATED(buff_tmp2)) &
+ &            .OR.((ALLOCATED(buff_tmp2)).AND.(i_qsz > i_bsz))
+    cbn = 'buff_tmp2'
+  ELSE
+    CALL ipslerr (3,'rest_alloc', &
+ &    'Called by '//TRIM(c_p),'with a wrong value of i_buff','')
+  ENDIF
+!-
+!-
+  IF (l_alloc1.OR.l_alloc2) THEN
+    IF (l_msg) THEN
+      IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) &
+ &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN
+        WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz
+      ELSE
+        WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz
+      ENDIF
+    ENDIF
+    IF (l_alloc1) THEN
+      IF (ALLOCATED(buff_tmp1)) THEN
+        DEALLOCATE(buff_tmp1)
+      ENDIF
+      ALLOCATE (buff_tmp1(i_qsz),STAT=i_err)
+    ELSE
+      IF (ALLOCATED(buff_tmp2)) THEN
+        DEALLOCATE(buff_tmp2)
+      ENDIF
+      ALLOCATE (buff_tmp2(i_qsz),STAT=i_err)
+    ENDIF
+    IF (i_err /= 0) THEN
+      WRITE (UNIT=c_err,FMT='(I5)') i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of',TRIM(cbn), &
+ &      'Error : '//TRIM(c_err)//' (you must increase memory)')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE rest_alloc
+!===
+SUBROUTINE ioconf_setatt (attname,value)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: attname,value
+!-
+  CHARACTER(LEN=LEN_TRIM(attname)) :: tmp_str
+!---------------------------------------------------------------------
+  tmp_str = attname
+  CALL strlowercase (tmp_str)
+!-
+  SELECT CASE(tmp_str)
+    CASE('units')
+      rest_units = value
+    CASE('long_name')
+      rest_lname = value
+    CASE DEFAULT
+      CALL ipslerr (2,'ioconf_restatt', &
+        'The attribute name provided is unknown',attname,' ')
+  END SELECT
+!---------------------------
+END SUBROUTINE ioconf_setatt
+!===
+SUBROUTINE ioget_vdim (fid,vname_q,varnbdim_max,varnbdim,vardims)
+!---------------------------------------------------------------------
+!- This routine allows the user to get the dimensions
+!- of a field in the restart file.
+!- This is the file which is read.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER,INTENT(IN) :: varnbdim_max
+  INTEGER,INTENT(OUT) ::  varnbdim
+  INTEGER,DIMENSION(varnbdim_max),INTENT(OUT) :: vardims
+!-
+  INTEGER :: vnb
+!---------------------------------------------------------------------
+! Find the index of the variable
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+  IF (vnb > 0) THEN
+    varnbdim = varnbdim_in(fid,vnb)
+    IF (varnbdim_max < varnbdim) THEN
+      CALL ipslerr (3,'ioget_vdim', &
+        'The provided array for the variable dimensions is too small', &
+        '','')
+    ELSE
+      vardims(1:varnbdim) = vardims_in(fid,vnb,1:varnbdim)
+    ENDIF
+  ELSE
+    varnbdim = 0
+    CALL ipslerr (2,'ioget_vdim', &
+      'Variable '//TRIM(vname_q)//' not found','','')
+  ENDIF
+!------------------------
+END SUBROUTINE ioget_vdim
+!===
+SUBROUTINE ioget_vname (fid,nbvar,varnames)
+!---------------------------------------------------------------------
+!- This routine allows the user to extract the list
+!- of variables in an opened restart file.
+!- This is the file which is read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  INTEGER,INTENT(OUT) ::  nbvar
+  CHARACTER(LEN=*),INTENT(OUT) :: varnames(:)
+!---------------------------------------------------------------------
+  nbvar = nbvar_in(fid)
+!-
+  IF (SIZE(varnames) < nbvar) THEN
+    CALL ipslerr (3,'ioget_vname', &
+      'The provided array for the variable names is too small','','')
+  ELSE
+    varnames(1:nbvar) = varname_in(fid,1:nbvar)
+  ENDIF
+!-------------------------
+END SUBROUTINE ioget_vname
+!===
+SUBROUTINE ioconf_expval (new_exp_val)
+!---------------------------------------------------------------------
+!- The default value written into the variables which are not
+!- in the restart file can only be changed once.
+!- This avoids further complications.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: new_exp_val
+!---------------------------------------------------------------------
+  IF (.NOT.lock_valexp) THEN
+    lock_valexp = .TRUE.
+    val_exp = new_exp_val
+  ELSE
+    CALL ipslerr (2,'ioconf_expval', &
+     'The default value for variable' &
+   //'not available in the restart file ', &
+     'has already been locked and can not be changed at this point', &
+     ' ')
+  ENDIF
+!---------------------------
+END SUBROUTINE ioconf_expval
+!===
+SUBROUTINE ioget_expval (get_exp_val)
+!---------------------------------------------------------------------
+!- Once the user has extracted the default value,
+!- we lock it so that it can not be changed anymore.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: get_exp_val
+!---------------------------------------------------------------------
+  get_exp_val = val_exp
+  lock_valexp = .TRUE.
+!--------------------------
+END SUBROUTINE ioget_expval
+!===
+SUBROUTINE restclo (fid)
+!---------------------------------------------------------------------
+!- This subroutine closes one or any opened restart file.
+!-
+!- INPUT
+!-
+!- fid    : File ID in the restcom system (not the netCDF ID)(optional)
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in),OPTIONAL :: fid
+!-
+  INTEGER :: iret,ifnc
+  CHARACTER(LEN=6) :: n_e
+  CHARACTER(LEN=3) :: n_f
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(fid)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+        'restclo : Closing specified restart file number :', &
+        fid,netcdf_id(fid,1:2)
+    ENDIF
+!---
+    IF (netcdf_id(fid,1) > 0) THEN
+      iret = NF90_CLOSE(netcdf_id(fid,1))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,1)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      IF (netcdf_id(fid,1) == netcdf_id(fid,2)) THEN
+        netcdf_id(fid,2) = -1
+      ENDIF
+      netcdf_id(fid,1) = -1
+    ENDIF
+!---
+    IF (netcdf_id(fid,2) > 0)  THEN
+      iret = NF90_CLOSE(netcdf_id(fid,2))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,2)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      netcdf_id(fid,2) = -1
+    ENDIF
+!---
+  ELSE
+!---
+    IF (l_dbg) WRITE(*,*) 'restclo : Closing all files'
+!---
+    DO ifnc=1,nb_fi
+      IF (netcdf_id(ifnc,1) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,1))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,1)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        ENDIF
+        IF (netcdf_id(ifnc,1) == netcdf_id(ifnc,2)) THEN
+          netcdf_id(ifnc,2) = -1
+        ENDIF
+        netcdf_id(ifnc,1) = -1
+      ENDIF
+!-----
+      IF (netcdf_id(ifnc,2) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,2))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,2)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        END IF
+        netcdf_id(ifnc,2) = -1
+      ENDIF
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE restclo
+!===
+!-----------------
+END MODULE restcom
Index: IOIPSL/tags/v2_1_9/src/stringop.f90
===================================================================
--- IOIPSL/tags/v2_1_9/src/stringop.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/src/stringop.f90	(revision 715)
@@ -0,0 +1,238 @@
+MODULE stringop
+!-
+!$Id$
+!-
+! 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: IOIPSL/tags/v2_1_9/tools/AA_make
===================================================================
--- IOIPSL/tags/v2_1_9/tools/AA_make	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/AA_make	(revision 715)
@@ -0,0 +1,68 @@
+#-
+#- $Id$
+#-
+#-Q- sxdkrz F_O = $(F_D) $(F_P) -C vsafe -size_t64 -I $(MODDIR)
+#-Q- eshpux F_O = $(F_D) $(F_P) -C vsafe -I $(MODDIR)
+#---------------------------------------------------------------------
+#- Create "tools" related to IOIPSL
+#---------------------------------------------------------------------
+
+SXMODEL_LIB = $(MODEL_LIB)
+ifeq ($(L_X),1)
+SXMODEL_LIB = $(LIBDIR)/libsxioipsl.a
+endif
+
+rbld: libioipsl $(BINDIR)/rebuild $(BINDIR)/flio_rbld
+	@echo rebuild is OK
+
+ncregular: $(BINDIR)/ncregular 
+	@echo ncregular is OK
+
+config: libioipsl $(BINDIR)/Fparser $(BINDIR)/tkparse
+	$(BINDIR)/Fparser -name IOIPSL *.f90
+	echo 'Configuration of IOIPSL done'
+
+$(BINDIR)/rebuild: ./rebuild
+	cp -p ./rebuild $(BINDIR)/rebuild
+	chmod a+rx $(BINDIR)/rebuild
+
+$(BINDIR)/flio_rbld: $(SXMODEL_LIB) flio_rbld.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) flio_rbld.f90
+	$(F_L) flio_rbld.o -o $(BINDIR)/flio_rbld \
+               $(L_O) $(SXMODEL_LIB) $(NCDF_LIB)
+	chmod a+rx $(BINDIR)/flio_rbld
+	$(RM) flio_rbld.o
+
+$(BINDIR)/ncregular: ncregular.f90
+	$(F_C) $(F_O) -I$(NCDF_INC) ncregular.f90
+	$(F_L) -o $(BINDIR)/ncregular ncregular.o $(L_O) $(NCDF_LIB)
+	$(RM) ncregular.o
+
+$(BINDIR)/Fparser: Fparser.o
+	$(F_L) -o $(BINDIR)/Fparser Fparser.o -L$(LIBDIR) -lioipsl
+	$(RM) Fparser.o
+
+Fparser.o: Fparser.f90
+	$(F_C) $(F_O) Fparser.f90
+
+$(BINDIR)/tkparse: tkparse.o tkcond.o tkgen.o
+	$(C_L) -o $(BINDIR)/tkparse tkparse.o tkcond.o tkgen.o
+	$(RM) tkparse.o tkcond.o tkgen.o
+
+tkparse.o: tkparse.c tkparse.h
+	$(C_C) $(C_O) -o tkparse.o tkparse.c
+
+tkcond.o: tkcond.c tkparse.h
+	$(C_C) $(C_O) -o tkcond.o tkcond.c
+
+tkgen.o: tkgen.c tkparse.h
+	$(C_C) $(C_O) -o tkgen.o tkgen.c
+
+libioipsl:
+	(cd ../src; $(M_K) -f Makefile)
+
+clean:
+	$(RM) *.*~ Makefile~ core *.o *.mod i.*.L *.L i.*.f90 *.M
+	$(RM) $(BINDIR)/rebuild $(BINDIR)/flio_rbld
+	$(RM) $(BINDIR)/ncregular $(BINDIR)/Fparser $(BINDIR)/tkparse
+
Index: IOIPSL/tags/v2_1_9/tools/AA_make.ldef
===================================================================
--- IOIPSL/tags/v2_1_9/tools/AA_make.ldef	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/AA_make.ldef	(revision 715)
@@ -0,0 +1,14 @@
+#-
+#- $Id$
+#-
+#---------------------------------------------------------------------
+#- Local parameters related to the "tools" of IOIPSL (rebuild, config)
+#---------------------------------------------------------------------
+SHELL = /bin/ksh
+#---------------------------------------------------------------------
+LIBDIR = ../../../lib
+BINDIR = ../../../bin
+MODDIR = $(LIBDIR)
+#---------------------------------------------------------------------
+P_P =
+MODEL_LIB = $(LIBDIR)/libioipsl.a
Index: IOIPSL/tags/v2_1_9/tools/Fparser.f90
===================================================================
--- IOIPSL/tags/v2_1_9/tools/Fparser.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/Fparser.f90	(revision 715)
@@ -0,0 +1,793 @@
+PROGRAM fparser
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+
+  USE stringop
+
+  IMPLICIT NONE
+  !
+  !
+  !     Parses the code to create the Config.in Config.default and Config.help
+  !     which are used by the tk shell.
+  !
+  !
+  INTEGER nbkeymax, nbhelpmax, nbcasemax, nbsourmax, nbelmax
+  PARAMETER (nbkeymax=100, nbhelpmax=50, nbcasemax=50, nbsourmax=20,nbelmax=nbhelpmax+10)
+  INTEGER nbfilesmax
+  PARAMETER (nbfilesmax=150)
+
+  !
+  CHARACTER*120 :: configs(nbkeymax,nbelmax)
+  CHARACTER*120 :: tmp_help, tmp_key, tmp_desc, tmp_def
+  INTEGER :: keylen(nbkeymax), nbkeys
+  INTEGER :: key_pos(nbkeymax), help_pos(nbkeymax,2), def_pos(nbkeymax,2)
+  INTEGER :: des_pos(nbkeymax), IF_pos(nbkeymax)
+  CHARACTER*6 TYPE_op(nbkeymax)
+  !
+  CHARACTER*120 :: def_out(nbkeymax, nbhelpmax)
+  INTEGER :: nbdef_out(nbkeymax)
+  !
+  CHARACTER*120 :: tke
+  !
+  CHARACTER*2 :: nbstr
+  !
+  CHARACTER*80 :: files(nbfilesmax), source(nbsourmax), filetmp
+  CHARACTER*80 :: tmp, main_name
+  CHARACTER*120 :: keycase(nbcasemax), tmp_CASE
+  INTEGER :: nbcase, ii, find, nbsource
+  LOGICAL :: next_source, next_name, last_or
+
+  LOGICAL :: is_main, cont
+
+  CHARACTER*1 :: backslash, simplequote, doublequote
+
+  INTEGER :: ia, iread, iret, IFF, ih, nb_line, iv, id
+  INTEGER :: ind_space, ind_comma, ind_USE
+  INTEGER :: nbfiles, nb_key, nb_key_file
+  !
+  INTEGER, EXTERNAL ::  iargc, getarg 
+  !
+  !
+  next_source = .FALSE.
+  next_name = .FALSE.
+  is_main = .FALSE.
+  nbsource = 0
+  nbfiles = 0
+  main_name = 'IPSL'
+  !
+  backslash = ACHAR(92)
+  simplequote = ACHAR(39)
+  doublequote = ACHAR(34)
+  !
+  !
+  !
+  !     Analyse command line
+  !
+  !
+  !     Get the number of arguments, that is the options and the
+  !     files to be parsed.
+  !
+  !
+
+  iread = iargc()
+  !
+  DO ia=1,iread
+     !
+     iret = getarg(ia,tmp)
+     !
+     IF (next_source) THEN
+
+        nbsource = nbsource + 1
+        IF ( nbsource .GT. nbsourmax) THEN
+           WRITE(*,*) 'Too many files to source in the arguments.' 
+           WRITE(*,*) 'Increase nbsourmax'
+           STOP
+        ELSE
+           source(nbsource) = tmp(1:LEN_TRIM(tmp))
+        ENDIF
+        next_source = .FALSE.
+
+     ELSE IF (next_name) THEN
+        main_name = tmp(1:LEN_TRIM(tmp))
+        next_name = .FALSE.
+
+     ELSE
+        !     
+        IF ( INDEX(tmp,'-m') .GT. 0) THEN
+           is_main = .TRUE.
+        ELSE IF ( INDEX(tmp,'-n') .GT. 0) THEN
+           next_name = .TRUE.
+        ELSE IF ( INDEX(tmp,'-s') .GT. 0) THEN
+           next_source = .TRUE.
+        ELSE IF ( INDEX(tmp,'-h') .GT. 0) THEN
+           WRITE(*,*) 'USAGE : Fparse [-name NAME] '
+           WRITE(*,*) '               [-source file_to_source]'
+           WRITE(*,*) '               [-main] FORTAN_files'
+        ELSE
+           nbfiles = nbfiles + 1
+           IF ( nbfiles .GT. nbfilesmax) THEN
+              WRITE(*,*) 'Too many files to include in &
+                   &                 the arguments.' 
+              WRITE(*,*) 'Increase nbfilesmax'
+              STOP
+           ELSE
+              files(nbfiles) = tmp(1:LEN_TRIM(tmp))
+           ENDIF
+        ENDIF
+
+     ENDIF
+
+  ENDDO
+  !
+  IF ( nbfiles .LT. 1 ) THEN
+     WRITE(*,*) 'No files provided'
+     STOP
+  ENDIF
+  !
+  !
+  !     1.0 Read files and extract the lines which we need
+  !
+  !
+  nb_key = 0
+  !
+  DO IFF=1,nbfiles
+     !
+     filetmp = files(IFF)
+     CALL READ_from_file(filetmp, nbkeymax, nbelmax, configs, nb_key, keylen)
+     !
+  ENDDO
+  !
+  !     2.0 Scan the information we have extracted from the file for the elements we need
+  !
+  !
+  CALL analyse_configs(nbkeymax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
+  !
+  !
+  !  3.0 Prepare the default values to put them in an array
+  !
+  !
+  DO ia = 1,nb_key
+     !
+     !  3.1 Go to blank delimited lines
+     !
+     nbdef_out(ia) = 0
+     !
+     DO ii=def_pos(ia,1), def_pos(ia,2)
+        !
+        tmp_help = configs(ia,ii)
+        ind_comma = INDEX(tmp_help(1:len_TRIM(tmp_help)),',')
+        DO WHILE (ind_comma .GT. 0) 
+           tmp_help(ind_comma:ind_comma) = ' '
+           ind_comma = INDEX(tmp_help,',')
+        ENDDO
+        CALL cmpblank(tmp_help)
+        configs(ia,ii) = tmp_help
+        !
+        !  3.2 extract the values
+        !
+        tmp_help = TRIM(ADJUSTL(configs(ia,ii)))
+        ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
+        ! Get the first one (there is no space in between)
+        IF ( ind_space .EQ. 0) THEN
+           nbdef_out(ia) = nbdef_out(ia) + 1
+           def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
+        ELSE
+           ! Get all those which are before spaces
+           DO WHILE (ind_space .GT. 0) 
+              nbdef_out(ia) = nbdef_out(ia) + 1
+              def_out(ia, nbdef_out(ia)) = tmp_help(1:ind_space)
+              tmp_help = ADJUSTL(tmp_help(ind_space+1:LEN_TRIM(tmp_help)))
+              ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
+           ENDDO
+           !    Get the last one which does not have a space behind
+           IF ( LEN_TRIM(tmp_help) .GT. 0) THEN
+              nbdef_out(ia) = nbdef_out(ia) + 1
+              def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
+           ENDIF
+           !
+        ENDIF
+     ENDDO
+     !
+  ENDDO
+  !
+  !
+  !
+  !      4.0 OPEN Config.in Defaults and Help files
+  !
+  !
+  OPEN (16, FILE='Config.in')
+  OPEN (17, FILE='Config.help')
+  OPEN (18, FILE='Config.defaults')
+  !
+  !     Some explantation
+  !
+  DO IFF=16,18
+     WRITE(IFF,'(1a)') '# '
+     WRITE(IFF,'(1a)') '# File created by Fparser, DO NOT EDIT'
+     WRITE(IFF,'(2a)') '# ', main_name(1:LEN_TRIM(main_name))
+     WRITE(IFF,'(1a)') '# '
+     WRITE(IFF,'(1a)') '# '
+  ENDDO
+  !
+  WRITE(17,'(2a)') '# Format of this file: description<nl>', &
+       &     ' variable<nl>helptext<nl><nl>.'
+  WRITE(17,'(2a)') '# If the question being documented is of', &
+       &     ' type "choice", we list'
+  WRITE(17,'(2a)') '# only the first occurring config variable.', &
+       &     ' The help texts'
+  WRITE(17,'(2a)') '# must not contain empty lines. No variable', &
+       &     ' should occur twice; if it'
+  WRITE(17,'(2a)') '# does, only the first occurrence will be', &
+       &     ' used by Configure. The lines'
+  WRITE(17,'(2a)') '# in a help text should be indented two', &
+       &     ' positions. Lines starting with'
+  WRITE(17,'(2a)') '# "#" are ignored. To be nice to menuconfig,', &
+       &     ' limit your lines to 70'
+  WRITE(17,'(2a)') '# characters. Use emacs" kfill.el to edit', &
+       &     ' this file or you lose.'
+  WRITE(17,'(2a)') '#'
+  !
+  IF ( is_main ) THEN
+     WRITE(16,'(3a)') 'mainmenu_name "Configuration of model ', &
+          &        main_name(1:LEN_TRIM(main_name)), '"'
+     WRITE(16,'(1a)') '# '
+  ENDIF
+  !
+  WRITE(16,'(1a)') 'mainmenu_option next_comment'
+  WRITE(16,'(3a)') 'comment "', main_name(1:LEN_TRIM(main_name)), '"'
+  WRITE(16,'(1a)') '# '
+  !
+  !   5.0 Loop through the KEYWORDS to prepare the output
+  !
+  DO IFF =1,nb_key
+     !
+     !     Config.in file
+     !
+
+     !
+     !     Is it a conditional option ?
+     !
+     IF ( IF_pos(IFF) .GE. 0)  THEN
+        tmp_help = configs(IFF,IF_pos(IFF))
+        !
+        IF ( (index(tmp_help,'||') .LE. 0) .AND. (index(tmp_help,'&&') .LE. 0) ) THEN
+           IF ( tmp_help(1:1) .EQ. '!') THEN
+              WRITE(16,'(3a)') 'if [ "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+           ELSE
+              WRITE(16,'(3a)') 'if [ "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+           ENDIF
+        ELSE
+           !
+           last_or = .TRUE.
+           nbcase = 0
+           !
+           DO WHILE( INDEX(tmp_help,'||') .GT. 0)
+              ii = INDEX(tmp_help,'||')
+              nbcase = nbcase + 1
+              if ( nbcase .EQ. 1 ) THEN
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ELSE
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') '-o "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') '-o "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ENDIF
+              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
+           ENDDO
+           !
+           DO WHILE( INDEX(tmp_help,'&&') .GT. 0)
+              ii = INDEX(tmp_help,'&&')
+              nbcase = nbcase + 1
+              if ( nbcase .EQ. 1 ) THEN
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ELSE
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') '-a "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') '-a "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ENDIF
+              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
+              last_or = .FALSE.
+           ENDDO
+           !
+           IF ( last_or ) THEN
+              IF ( tmp_help(1:1) .EQ. '!') THEN
+                 WRITE(16,'(3a)') '-o "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+              ELSE
+                 WRITE(16,'(3a)') '-o "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+              ENDIF
+           ELSE
+              IF ( tmp_help(1:1) .EQ. '!') THEN
+                 WRITE(16,'(3a)') '-a "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+              ELSE
+                 WRITE(16,'(3a)') '-a "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+              ENDIF
+           ENDIF
+        ENDIF
+        WRITE(16,'(1a)') '       '
+     ENDIF
+     !
+     !      Extract the information from configs
+     !
+     DO iv = 1,nbdef_out(IFF)
+
+        IF (nbdef_out(IFF) .EQ. 1) THEN
+           tmp_key = configs(IFF,key_pos(IFF))
+           tmp_desc = configs(IFF,des_pos(IFF))
+           tmp_def = def_out(IFF,iv)
+        ELSE
+           tmp_key = configs(IFF,key_pos(IFF))
+           WRITE(nbstr,'(I2.2)') iv
+           tmp_key = tmp_key(1:LEN_TRIM(tmp_key))//'__'//nbstr
+           tmp_desc = configs(IFF,des_pos(IFF))
+           IF ( iv .EQ. 1) THEN
+              tmp_desc = tmp_desc(1:LEN_TRIM(tmp_desc))//' (Vector)'
+           ELSE
+              tmp_desc = 'Cont...    '//tmp_key(1:LEN_TRIM(tmp_key))
+           ENDIF
+           tmp_def = def_out(IFF,iv)
+        ENDIF
+        !
+        !
+        !
+        IF (INDEX(TYPE_op(IFF),'bool') .GT. 0) THEN
+           !
+           WRITE(16,'(4a)') 'bool "', tmp_desc(1:LEN_TRIM(tmp_desc)), &
+                &              '" ',tmp_key(1:LEN_TRIM(tmp_key))
+           !
+        ELSE IF (INDEX(TYPE_op(IFF),'hex') .GT. 0) THEN
+           !
+           WRITE(16,'(6a)') 'hex "', tmp_desc(1:LEN_TRIM(tmp_desc)) &
+                &              ,'" ',tmp_key(1:LEN_TRIM(tmp_key)) &
+                &              ,' ',tmp_def(1:LEN_TRIM(tmp_def))
+           !
+        ELSE IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+           !
+           !   Get number of options
+           !
+           nbcase = 0
+           DO WHILE( INDEX(tmp_key,'||') .GT. 0)
+              ii = INDEX(tmp_key,'||')
+              nbcase = nbcase + 1
+              keycase(nbcase) = tmp_key(1:ii-1)
+              tmp_key=tmp_key(ii+2:LEN_TRIM(tmp_key))
+           ENDDO
+           nbcase = nbcase + 1
+           keycase(nbcase) = tmp_key(1:LEN_TRIM(tmp_key))
+
+           WRITE(16,'(4a)') "choice '", tmp_desc(1:LEN_TRIM(tmp_desc))," '",backslash
+           !
+           !   List options
+           !
+           tmp_CASE = keycase(1)
+           WRITE(16,'(5a)') '        "', tmp_CASE(1:LEN_TRIM(tmp_CASE)), "          "&
+                &,tmp_CASE(1:LEN_TRIM(tmp_CASE)), backslash
+           !
+           DO ii=2,nbcase-1
+              tmp_CASE = keycase(ii)
+              WRITE(16,'(5a)') '         ',   tmp_CASE(1:LEN_TRIM(tmp_CASE)),  '          ',&
+                   & tmp_CASE(1:LEN_TRIM(tmp_CASE)),  backslash
+           ENDDO
+           !
+           tmp_CASE = keycase(nbcase)
+           WRITE(16,'(6a)') '         ', &
+                &              tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
+                &              '          ', tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
+                &              '"  ',tmp_def(1:LEN_TRIM(tmp_def)) 
+           !
+        ELSE
+           WRITE(*,'(2a)') 'Uniplemented operation : ', TYPE_op(IFF)
+           STOP
+        ENDIF
+        !
+        !     Config.help file
+        !
+        tmp_key = configs(IFF,key_pos(IFF))
+        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+           ii = INDEX(tmp_key,'||')-1
+        ELSE
+           ii = LEN_TRIM(tmp_key)
+        ENDIF
+
+        IF ( nbdef_out(IFF) .GT. 1) THEN
+           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
+           WRITE(nbstr,'(I2.2)') iv
+           tke = tmp_key(1:ii)//'__'//nbstr
+           WRITE(17,'(1a)') tke(1:LEN_TRIM(tke))
+           WRITE(17,'(1a)') '  (Vector)'
+        ELSE
+           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
+           WRITE(17,'(1a)') tmp_key(1:ii)
+        ENDIF
+        !
+        DO ih=help_pos(IFF,1),help_pos(IFF,2)
+           tmp_help = configs(IFF,ih)
+           WRITE(17,'("  ",1a)') tmp_help(1:LEN_TRIM(tmp_help))
+        ENDDO
+        !
+        !     Config.default file
+        !
+        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+
+           WRITE(18,'(2a)') tmp_def(1:LEN_TRIM(tmp_def)),'=y'
+
+        ELSE
+
+           WRITE(18,'(3a)') tmp_key(1:LEN_TRIM(tmp_key)),'=', &
+                &              tmp_def(1:LEN_TRIM(tmp_def))
+
+        ENDIF
+        !     
+        !     Add some empty line to all files
+        !     
+        WRITE(16,'(1a)') '       '
+        WRITE(17,'(1a)') '       '
+        WRITE(17,'(1a)') '       '
+     ENDDO
+     !
+     !
+     !     Close the IF if needed
+     !
+
+     IF ( IF_pos(IFF) .GT. 0) THEN
+        WRITE(16,'(1a)') 'fi'
+        WRITE(16,'(1a)') '       '
+     ENDIF
+
+     !
+  ENDDO
+  !
+  WRITE(16,'(1a)') 'endmenu'
+  WRITE(16,'(1a)') '       '
+  IF ( nbsource .GT. 0) THEN
+     DO ih=1,nbsource
+        tmp = source(ih)
+        WRITE(16,'(1a)') '              '
+        WRITE(16,'(3a)') 'source ',tmp(1:LEN_TRIM(tmp)), &
+             &           '/Config.in'
+     ENDDO
+  ENDIF
+  !
+  !
+  CLOSE(16)
+  CLOSE(17)
+  CLOSE(18)
+  !
+  !
+  !
+  STOP
+
+END PROGRAM fparser
+!
+!
+!==========================================================
+!
+!
+SUBROUTINE READ_from_file(file, nbkeymax, nbelmax, configs, nbitems, itemlen)
+  !
+  USE stringop
+  !
+  IMPLICIT NONE
+  !
+  !
+  !     This routine reads the file and adds the config info it finds to the configs array.
+  !     Thus the nbitems is an imput variable as it can be increased as we go through the files.
+  !
+  !
+  CHARACTER*(*) :: file
+  INTEGER :: nbkeymax, nbelmax
+  CHARACTER*120 :: configs(nbkeymax, nbelmax)
+  INTEGER ::  nbitems, itemlen(nbkeymax)
+  !
+  INTEGER :: conf_pos, ip
+  CHARACTER*250 line
+  LOGICAL :: cont, conf_END
+  !
+  cont = .TRUE.
+  conf_END = .TRUE.
+  !
+  OPEN (12, file=file)
+  !
+  !   1.0 Loop over all the lines of a given file to extract all the configuration line
+  !
+  DO WHILE (cont)
+    READ(12,'(a)',END=9999) line
+    !
+    !   1.0  A configuration line is detected by the line below.
+    !
+    IF ( INDEX(line,'Config') .EQ. 1 .OR. INDEX(line,'!'//'Config') .GE. 1 ) THEN
+        !
+        IF ( conf_END ) THEN
+            nbitems = nbitems + 1
+            IF ( nbitems .GT. nbkeymax) THEN
+                WRITE(*,*) 'read_from_file : The number of keys in the input array is too small for this file'
+                STOP
+            ENDIF
+            itemlen(nbitems) = 0
+            conf_END = .FALSE.
+        ENDIF
+        !
+        itemlen(nbitems) = itemlen(nbitems) + 1
+        IF ( itemlen(nbitems) .GT. nbelmax ) THEN
+            WRITE(*,*) 'read_from_file : The number of elements per key in the input array is too small'
+            STOP
+        ENDIF
+        !
+        !  The detected line is shaved !
+        !
+        IF ( INDEX(line,'Config') .EQ. 1) THEN
+            conf_pos = 7
+        ELSE
+            conf_pos = INDEX(line,'!'//'Config') +7
+        ENDIF
+        line = line(conf_pos:LEN_TRIM(line))
+        line = TRIM(ADJUSTL(line))
+        CALL cmpblank(line)
+        !
+        configs(nbitems,itemlen(nbitems)) = line
+        !
+    ELSE
+        !
+        !   Look for the end of a configuration structure.
+        !  It is determined by a call to the getin subroutine
+        !
+        CALL strlowercase(line)
+        CALL cmpblank(line)
+        ip = INDEX(line,' (')
+        DO WHILE (ip .GT. 0)
+          line = line(1:ip-1)//line(ip+1:LEN_TRIM(line))
+          ip = INDEX(line,' (')
+        ENDDO
+        IF ( INDEX(line, 'call getin(') .GT. 0 .OR. INDEX(line, 'call setvar(') .GT. 0) THEN
+            conf_END = .TRUE.
+        ENDIF
+        !
+    ENDIF
+    !
+    cont = .TRUE.
+    GOTO 8888
+9999 cont = .FALSE.
+8888 CONTINUE
+    
+    ENDDO
+  !
+  CLOSE(12)
+  !
+  END SUBROUTINE READ_from_file
+  !
+  !==========================================================
+  !
+  !
+  SUBROUTINE analyse_configs(nbkmax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
+    !
+  USE stringop
+  !
+    IMPLICIT NONE
+    !
+    !
+    !    This subroutine will localize the KEYWORDS in the configs array
+    !    and extract all their arguments. For the moment 5 arguments are recognized :
+    !    KEY  : The keyword by which the all is identified
+    !    HELP : This identifies the help text
+    !    DEF : The default value of for this KEYWORD
+    !    DESC : A short description, not more than one line
+    !    IF : Specifies the other Keyword it depend on. This is a nice features for the menus as it can hide 
+    !            things we do not need
+    !
+    !    The DEF and HELP keywords can be multi line
+    !
+    INTEGER :: nbkmax, nb_key, nbelmax
+    INTEGER :: keylen(nbkmax)
+    INTEGER :: key_pos(nbkmax), help_pos(nbkmax,2), def_pos(nbkmax,2), des_pos(nbkmax), IF_pos(nbkmax)
+    CHARACTER*120 :: configs(nbkmax,nbelmax)
+    CHARACTER*6 :: TYPE_op(nbkmax)
+    !
+    !   This is the number of arguments we need to find an end for and the total number of arguments  we can have.
+    !   Thus these parameters needs to be updated when the list of arguments to the routine is changed
+    !
+    INTEGER, PARAMETER :: toendlen=2, indexlen=5
+    !
+    INTEGER :: toend(toendlen), foundend(toendlen), kindex(indexlen)
+    INTEGER :: ik, il, ieq
+    CHARACTER*120 :: tmp_str, tmp_str2
+    !
+    !
+    key_pos(1:nb_key)=-1
+    help_pos(1:nb_key,1:2)=-1
+    def_pos(1:nb_key,1:2)=-1
+    des_pos(1:nb_key)=-1
+    IF_pos(1:nb_key)=-1
+    TYPE_op(1:nb_key)='hex'
+    !
+    DO ik=1,nb_key
+      !
+      !
+      DO il=1,keylen(ik)
+        !
+        ieq = INDEX(configs(ik,il),'=')
+        tmp_str = configs(ik,il)
+        tmp_str = tmp_str(1:ieq)
+        CALL struppercase(tmp_str)
+        !
+        !      Decide if this is a reserved name and where it fits
+        !
+        !      At the same time we clean up the configs array
+        !
+        IF ( INDEX(tmp_str,'KEY') .GT. 0) THEN
+            IF ( key_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a KEYWORD, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            key_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+            !
+            !   Here we have to check that we are not in an 'choice' case
+            !
+            IF ( INDEX(tmp_str2,'||') .GT. 0) THEN
+                TYPE_op(ik) = 'choice'
+            ENDIF
+            !
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'DEF') .GT. 0) THEN
+            IF ( def_pos(ik,1) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a DEF, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            def_pos(ik,1) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            tmp_str2 = TRIM(ADJUSTL(tmp_str2))
+            configs(ik,il) = tmp_str2 
+            !
+            !  Here we can check if we have a boolean operation
+            !  We also wish to standardise the value of booleans
+            !
+            CALL struppercase(tmp_str2)
+            IF (INDEX(tmp_str2,'Y') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'T') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'YES') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 3 .OR.&
+               & INDEX(tmp_str2,'TRUE') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 4 .OR.&
+               & INDEX(tmp_str2,'.TRUE.') .EQ. 1) THEN
+                configs(ik,il) = 'y'
+                TYPE_op(ik) = 'bool'
+            ENDIF
+            !
+            IF (INDEX(tmp_str2,'N') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'F') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'NO') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 2 .OR.&
+               & INDEX(tmp_str2,'FALSE') .EQ. 1  .AND. LEN_TRIM(tmp_str2) .EQ. 5 .OR.&
+               & INDEX(tmp_str2,'.FALSE.') .EQ. 1) THEN
+                configs(ik,il) = 'n'
+                TYPE_op(ik) = 'bool'
+            ENDIF
+            !
+            ! Here we check if we have a default behavior and put a standard name
+            !
+            IF (INDEX(tmp_str2,'DEF') .EQ. 1 .OR. INDEX(tmp_str2,'NONE') .EQ. 1) THEN
+                configs(ik,il) = 'default'
+            ENDIF
+            !
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'DESC') .GT. 0) THEN
+            IF ( des_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a DESC, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            des_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'IF') .GT. 0) THEN
+            IF ( IF_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a IF, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            IF_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF 
+        !
+        IF ( INDEX(tmp_str,'HELP') .GT. 0) THEN
+            help_pos(ik,1) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF
+        !
+      ENDDO
+      !
+      !     Check if we not missing some important informations as for instance
+      !
+      !     THE KEYWORD 
+      !
+      IF ( key_pos(ik) .LT. 1) THEN
+          WRITE(*,*) 'analyse_configs : Could not find a keyword in the following entry :'
+          DO il=1,keylen(ik)
+            WRITE(*,'(a70)') configs(ik,il)
+          ENDDO
+          STOP
+      ENDIF
+      !
+      !      THE DEFAULT VALUE
+      !
+      IF ( def_pos(ik,1) .LT. 1) THEN
+          WRITE(*,*) 'analyse_configs : Could not find a default value in the following entry :'
+          DO il=1,keylen(ik)
+            WRITE(*,'(a70)') configs(ik,il)
+          ENDDO
+          STOP
+      ENDIF
+      !
+      !   Get the end of all the multi line arguments
+      !
+      toend(1) = MAX(def_pos(ik,1),1)
+      toend(2) = MAX(help_pos(ik,1),1)
+      foundend(:) = keylen(ik)
+      kindex(1) = MAX(key_pos(ik),1)
+      kindex(2) = MAX(des_pos(ik),1)
+      kindex(3) = MAX(def_pos(ik,1),1)
+      kindex(4) = MAX(IF_pos(ik),1)
+      kindex(5) = MAX(help_pos(ik,1),1)
+      CALL find_ends(toendlen, toend, indexlen, kindex, foundend)
+      def_pos(ik,2) = foundend(1)
+      help_pos(ik,2) = foundend(2)
+      !
+    ENDDO
+    !
+  END SUBROUTINE analyse_configs
+  !
+  SUBROUTINE find_ends(toendlen, toend, indexlen, kindex, foundend)
+    !
+    IMPLICIT NONE
+    !
+    !
+    !  We find the end of the text for all the elements in the key which are multi line
+    !   This subroutine aims at providing a flexible way to determine this so that other
+    !   elements in the Keyword can be multi line. For the moment it is only the Help and Ded 
+    !  which are allowed to be multi line.
+    !
+    !  Foundend need to be initialized to the maximum value of the elements
+    !
+    !
+    INTEGER :: toendlen, toend(toendlen), indexlen, kindex(indexlen), foundend(toendlen)
+    !
+    INTEGER :: whmin(1), ie, ii
+    !
+    DO ie=1,toendlen
+      !
+      whmin = MINLOC(toend(1:toendlen))
+      !
+      DO ii=1,indexlen
+        IF ( kindex(ii) .GT. toend(whmin(1)) .AND. foundend(whmin(1)) .GE. kindex(ii)) THEN
+            foundend(whmin(1)) = kindex(ii)-1
+            toend(whmin(1)) = 100000
+        ENDIF
+      ENDDO
+      !
+    ENDDO
+    !
+  END SUBROUTINE find_ends
Index: IOIPSL/tags/v2_1_9/tools/flio_rbld.f90
===================================================================
--- IOIPSL/tags/v2_1_9/tools/flio_rbld.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/flio_rbld.f90	(revision 715)
@@ -0,0 +1,1622 @@
+PROGRAM flio_rbld
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! PROGRAM flio_rbld
+!!
+!! PURPOSE :
+!!   Recombine the files of MPI version of IOIPSL
+!!   along several dimensions.
+!!
+!! CALLING SEQUENCE :
+!!
+!!   "flio_rbld" is usually invoked by the script "rebuild"
+!!
+!!   rebuild -h
+!!
+!!   rebuild [-v lev] [-f] -o outfile infile[1] ... infile[n]
+!!
+!! INPUT for "rebuild" :
+!!
+!!   -h         : help
+!!   -v lev     : verbosity level
+!!   -f         : force executing mode
+!!   -o outfile : name of the recombined file.
+!!   infiles    : names of the files that must be recombined.
+!!
+!! INPUT for "flio_rbld" :
+!!
+!!  (I) i_v_lev  : verbosity level
+!!  (C) c_force  : executing mode (noforce/force)
+!!  (I) f_nb     : total number of files
+!!  (C) f_nm(:)  : names of the files (input_files output_file)
+!!
+!!
+!! ASSOCIATED MODULES :
+!!   IOIPSL(fliocom)
+!!
+!! RESTRICTIONS :
+!!
+!!   Cases for character are not coded.
+!!
+!!   Cases for netCDF variables such as array with more
+!!   than 5 dimensions are not coded.
+!!
+!!   Input files must have the following global attributes :
+!!
+!!     "DOMAIN_number_total"
+!!     "DOMAIN_number"
+!!     "DOMAIN_dimensions_ids"
+!!     "DOMAIN_size_global"
+!!     "DOMAIN_size_local"
+!!     "DOMAIN_position_first"
+!!     "DOMAIN_position_last"
+!!     "DOMAIN_halo_size_start"
+!!     "DOMAIN_halo_size_end"
+!!     "DOMAIN_type"
+!!
+!!   NetCDF files must be smaller than 2 Gb.
+!!
+!!   Character variables should have less than 257 letters
+!!
+!! EXAMPLE :
+!!
+!!   rebuild -v -o sst.nc sst_[0-9][0-9][0-9][0-9].nc
+!!
+!! MODIFICATION HISTORY :
+!!   Sebastien Masson   (smasson@jamstec.go.jp)   March 2004
+!!   Jacques   Bellier  (Jacques.Bellier@cea.fr)  June  2005
+!!--------------------------------------------------------------------
+  USE IOIPSL
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+!-
+! DO loops and test related variables
+  INTEGER :: i,ia,id,iv,iw,i_i,i_n
+  INTEGER :: ik,itmin,itmax,it1,it2,it
+  LOGICAL :: l_force,l_uld
+!-
+! Input arguments related variables
+  INTEGER :: i_v_lev
+  CHARACTER(LEN=15) :: c_force
+  INTEGER :: f_nb,f_nb_in
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm
+!-
+! Domains related variables
+  INTEGER :: d_n_t,i_ntd
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dom_att,d_d_i,d_s_g
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: d_s_l,d_p_f,d_p_l,d_h_s,d_h_e
+  LOGICAL :: l_cgd,l_cof,l_col,l_o_f,l_o_m,l_o_l
+  CHARACTER(LEN=chlen) :: c_d_n
+!-
+! Model files related variables
+  LOGICAL :: l_ocf
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id
+  INTEGER :: f_id_i1,f_id_i,f_id_o
+  INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_d_ul
+  INTEGER :: v_a_nb,a_type
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: &
+&  f_d_nm,f_v_nm,f_a_nm,v_a_nm
+  CHARACTER(LEN=chlen) :: f_u_nm
+  INTEGER,DIMENSION(:),ALLOCATABLE :: v_d_nb,v_d_ul,v_type
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: v_d_i
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l
+  INTEGER :: a_l
+  INTEGER,DIMENSION(flio_max_var_dims) :: d_i,ib,ie
+  INTEGER,DIMENSION(:),ALLOCATABLE :: &
+ &  io_i,io_n,ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl
+  LOGICAL :: l_ex
+  CHARACTER(LEN=chlen) :: c_wn1,c_wn2
+!-
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1) :: i1_0d
+!?INTEGER(KIND=i_1),DIMENSION(:),ALLOCATABLE :: i1_1d
+!?INTEGER(KIND=i_1),DIMENSION(:,:),ALLOCATABLE :: i1_2d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),ALLOCATABLE :: i1_3d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),ALLOCATABLE :: i1_4d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i1_5d
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2),DIMENSION(:),ALLOCATABLE :: i2_1d
+  INTEGER(KIND=i_2),DIMENSION(:,:),ALLOCATABLE :: i2_2d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),ALLOCATABLE :: i2_3d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),ALLOCATABLE :: i2_4d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i2_5d
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4),DIMENSION(:),ALLOCATABLE :: i4_1d
+  INTEGER(KIND=i_4),DIMENSION(:,:),ALLOCATABLE :: i4_2d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),ALLOCATABLE :: i4_3d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),ALLOCATABLE :: i4_4d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i4_5d
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4),DIMENSION(:),ALLOCATABLE :: r4_1d
+  REAL(KIND=r_4),DIMENSION(:,:),ALLOCATABLE :: r4_2d
+  REAL(KIND=r_4),DIMENSION(:,:,:),ALLOCATABLE :: r4_3d
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),ALLOCATABLE :: r4_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r4_5d
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8),DIMENSION(:),ALLOCATABLE :: r8_1d
+  REAL(KIND=r_8),DIMENSION(:,:),ALLOCATABLE :: r8_2d
+  REAL(KIND=r_8),DIMENSION(:,:,:),ALLOCATABLE :: r8_3d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),ALLOCATABLE :: r8_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r8_5d
+!-
+! elapsed and cpu time computation variables
+  INTEGER :: nb_cc_ini,nb_cc_end,nb_cc_sec,nb_cc_max
+  REAL :: t_cpu_ini,t_cpu_end
+!---------------------------------------------------------------------
+!-
+!-------------------
+! INPUT arguments
+!-------------------
+!-
+! Retrieve the verbosity level
+  READ (UNIT=*,FMT=*) i_v_lev
+!-
+! Retrieve the executing mode
+  READ (UNIT=*,FMT='(A)') c_force
+  l_force = (TRIM(c_force)  == 'force')
+!-
+! Retrieve the number of arguments
+  READ (UNIT=*,FMT=*) f_nb
+  f_nb_in = f_nb-1
+!-
+! Retrieve the file names
+  ALLOCATE(f_nm(f_nb))
+  DO iw=1,f_nb
+    READ (UNIT=*,FMT='(A)') f_nm(iw)
+  ENDDO
+!-
+! Allocate and initialize the array of file access identifiers
+  ALLOCATE(f_a_id(f_nb_in)); f_a_id(:) = -1;
+!-
+  IF (i_v_lev >= 1) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,FMT='(" verbosity level : ",I4)') i_v_lev
+    WRITE (UNIT=*,FMT='(" executing  mode : ",A)') TRIM(c_force)
+    WRITE (UNIT=*,FMT='(" number of args  : ",I4)') f_nb
+    WRITE (UNIT=*,FMT='(" Input  files :")')
+    DO iw=1,f_nb_in
+      WRITE (*,'("   ",A)') TRIM(f_nm(iw))
+    ENDDO
+    WRITE (UNIT=*,FMT='(" Output file  :")')
+    WRITE (*,'("   ",A)') TRIM(f_nm(f_nb))
+!-- time initializations
+    CALL system_clock &
+ &   (count=nb_cc_ini,count_rate=nb_cc_sec,count_max=nb_cc_max)
+    CALL cpu_time (t_cpu_ini)
+  ENDIF
+!-
+!---------------------------------------------------
+! Retrieve basic informations from the first file
+!---------------------------------------------------
+!-
+! Open the first file
+  CALL flrb_of (1,f_id_i)
+!-
+! Get the attribute "DOMAIN_number_total"
+  CALL fliogeta (f_id_i,"?","DOMAIN_number_total",d_n_t)
+!-
+! Validate the number of input files :
+! should be equal to the total number
+! of domains used in the simulation
+  IF (d_n_t /= f_nb_in) THEN
+    IF (l_force) THEN
+      iw = 2
+    ELSE
+      iw = 3
+      DEALLOCATE(f_nm,f_a_id)
+      CALL flrb_cf (1,.TRUE.)
+    ENDIF
+    CALL ipslerr (iw,"flio_rbld", &
+ &   "The number of input files", &
+ &   "is not equal to the number of DOMAINS"," ")
+  ENDIF
+!-
+! Retrieve the basic characteristics of the first input file
+  CALL flioinqf &
+ & (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_d_ul)
+!-
+! Build the list of the names of the
+! dimensions/variables/global_attributes and retrieve
+! the unlimited_dimension name from the first input file
+  ALLOCATE(f_d_nm(f_d_nb),f_v_nm(f_v_nb),f_a_nm(f_a_nb))
+  CALL flioinqn (f_id_i,cn_dim=f_d_nm,cn_var=f_v_nm, &
+ &                      cn_gat=f_a_nm,cn_uld=f_u_nm)
+!-
+! Build the list of the dimensions identifiers and lengths
+  ALLOCATE(f_d_i(f_d_nb),f_d_l(f_d_nb))
+  CALL flioinqf (f_id_i,id_dim=f_d_i,ln_dim=f_d_l)
+!-
+! Close the file
+  CALL flrb_cf (1,.FALSE.)
+!-
+! Check if the number of needed files is greater than
+! the maximum number of simultaneously opened files.
+! In that case, open and close model files for each reading,
+! otherwise keep the "flio" identifiers of the opened files.
+  l_ocf = (f_nb > flio_max_files)
+!-
+!----------------------------------------------------
+! Retrieve domain informations for each input file
+!----------------------------------------------------
+!-
+  DO iw=1,f_nb_in
+!---
+    CALL flrb_of (iw,f_id_i)
+!---
+    IF (iw > 1) THEN
+      c_wn1 = "DOMAIN_number_total"
+      CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+      IF (l_ex) THEN
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),i_ntd)
+        IF (i_ntd /= d_n_t) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &        "File      : "//TRIM(f_nm(iw)), &
+ &        "Attribute : "//TRIM(c_wn1), &
+ &        "not equal to the one of the first file")
+        ENDIF
+      ELSE
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1),"not found")
+      ENDIF
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_dimensions_ids"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      ALLOCATE(dom_att(a_l))
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+      IF (iw == 1) THEN
+        IF (ANY(dom_att(:) == f_d_ul)) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "contains the unlimited dimension")
+        ENDIF
+        ALLOCATE (d_d_i(a_l))
+        d_d_i(:) = dom_att(:)
+      ELSEIF (SIZE(dom_att) /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ELSEIF (ANY(dom_att(:) /= d_d_i(:))) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+      DEALLOCATE(dom_att)
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_global"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_g(a_l))
+          d_s_g(:)=dom_att(:)
+        ELSEIF (ANY(dom_att(:) /= d_s_g(:))) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "not equal to the one of the first file")
+        ENDIF
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_local"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_l(a_l,f_nb_in))
+        ENDIF
+        d_s_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_first"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_f(a_l,f_nb_in))
+        ENDIF
+        d_p_f(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_last"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_l(a_l,f_nb_in))
+        ENDIF
+        d_p_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_start"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_s(a_l,f_nb_in))
+        ENDIF
+        d_h_s(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_end"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_e(a_l,f_nb_in))
+        ENDIF
+        d_h_e(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_type"
+    c_wn2 = " "
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),c_wn2)
+      CALL strlowercase (c_wn2)
+      IF (iw == 1) THEN
+        IF (    (TRIM(c_wn2) == "box") &
+ &          .OR.(TRIM(c_wn2) == "apple") ) THEN
+          c_d_n = c_wn2
+        ELSE
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "type "//TRIM(c_wn2)//" not (yet) supported")
+        ENDIF
+      ELSEIF (TRIM(c_wn2) /= TRIM(c_d_n)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    CALL flrb_cf (iw,l_ocf)
+!---
+  ENDDO
+!-
+  IF (i_v_lev >= 2) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From the first file : ")')
+    WRITE (*,'("   Number of dimensions : ",I2)') f_d_nb
+    WRITE (*,'("     Idents  : ",(10(1X,I4),:))') f_d_i(1:f_d_nb)
+    WRITE (*,'("     Lengths : ",(10(1X,I4),:))') f_d_l(1:f_d_nb)
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_d_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_d_nm(i))
+    ENDDO
+    IF (f_d_ul > 0) THEN
+      WRITE (*,'("   Unlimited dimension id : ",I2)') f_d_i(f_d_ul)
+    ENDIF
+    WRITE (*,'("   Number of variables  : ",I2)') f_v_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_v_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_v_nm(i))
+    ENDDO
+    WRITE (*,'("   Number of global attributes : ",I2)') f_a_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_a_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_a_nm(i))
+    ENDDO
+  ENDIF
+  IF (i_v_lev >= 3) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From input files : ")')
+    WRITE (*,'("   Total number of DOMAINS : ",I4)') d_n_t
+    WRITE (*,'("   DOMAIN_dimensions_ids :",(10(1X,I5),:))') d_d_i(:)
+    WRITE (*,'("   DOMAIN_size_global    :",(10(1X,I5),:))') d_s_g(:)
+    WRITE (*,'("   DOMAIN_type           : """,(A),"""")') TRIM(c_d_n)
+    DO iw=1,f_nb_in
+      WRITE (*,'("   File   : ",A)') TRIM(f_nm(iw))
+      WRITE (*,'("     d_s_l  :",(10(1X,I5),:))') d_s_l(:,iw)
+      WRITE (*,'("     d_p_f  :",(10(1X,I5),:))') d_p_f(:,iw)
+      WRITE (*,'("     d_p_l  :",(10(1X,I5),:))') d_p_l(:,iw)
+      WRITE (*,'("     d_h_s  :",(10(1X,I5),:))') d_h_s(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_s(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Beginning offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+      WRITE (*,'("     d_h_e  :",(10(1X,I5),:))') d_h_e(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_e(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Ending offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+!---------------------------------------
+! Create the dimensionned output file
+!---------------------------------------
+!-
+! Define the dimensions used in the output file
+  DO id=1,f_d_nb
+    DO i=1,SIZE(d_d_i)
+      IF (f_d_i(id) == d_d_i(i)) THEN
+        f_d_l(id) = d_s_g(i)
+      ENDIF
+    ENDDO
+  ENDDO
+!-
+  IF (f_d_ul > 0) THEN
+    i = f_d_l(f_d_ul); f_d_l(f_d_ul) = -1;
+  ENDIF
+!-
+! Create the output file
+  CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1)
+!-
+  IF (f_d_ul > 0) THEN
+    f_d_l(f_d_ul) = i; itmin = 1; itmax = f_d_l(f_d_ul);
+  ELSE
+    itmin = 1; itmax = 1;
+  ENDIF
+!-
+! open the first input file used to build the output file
+!-
+  CALL flrb_of (1,f_id_i1)
+!-
+! define the global attributes in the output file
+! copy all global attributes except those beginning by "DOMAIN_"
+! eventually actualize the "file_name" attribute
+!-
+  DO ia=1,f_a_nb
+    IF (INDEX(TRIM(f_a_nm(ia)),"DOMAIN_") == 1)  CYCLE
+    IF (TRIM(f_a_nm(ia)) == "file_name") THEN
+      CALL flioputa (f_id_o,"?",TRIM(f_a_nm(ia)),TRIM(c_wn1))
+    ELSE
+      CALL fliocpya (f_id_i1,"?",TRIM(f_a_nm(ia)),f_id_o,"?")
+    ENDIF
+  ENDDO
+!-
+! define the variables in the output file
+!-
+  ALLOCATE(v_d_nb(f_v_nb)); v_d_nb(:) = 0;
+  ALLOCATE(v_d_ul(f_v_nb)); v_d_ul(:) = 0;
+  ALLOCATE(v_type(f_v_nb),v_d_i(flio_max_var_dims,f_v_nb));
+  DO iv=1,f_v_nb
+!-- get variable informations
+    CALL flioinqv &
+ &   (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type(iv), &
+ &    nb_dims=v_d_nb(iv),id_dims=d_i,nb_atts=v_a_nb)
+!-- define the new variable
+    IF (v_d_nb(iv) == 0) THEN
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type(iv))
+    ELSE
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),d_i(1:v_d_nb(iv)),v_t=v_type(iv))
+      DO iw=1,v_d_nb(iv)
+        IF (f_d_ul > 0) THEN
+          IF (d_i(iw) == f_d_ul) THEN
+            v_d_ul(iv) = iw
+          ENDIF
+        ENDIF
+      ENDDO
+      v_d_i(1:v_d_nb(iv),iv) = d_i(1:v_d_nb(iv))
+    ENDIF
+!-- copy all variable attributes
+    ALLOCATE(v_a_nm(v_a_nb))
+    CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
+    DO ia=1,v_a_nb
+      CALL fliocpya &
+ &     (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
+ &      f_id_o,TRIM(f_v_nm(iv)))
+    ENDDO
+    DEALLOCATE(v_a_nm)
+  ENDDO
+!-
+! update valid_min valid_max attributes values
+!-
+  CALL flrb_rg
+!-
+!------------------------
+! Fill the output file
+!------------------------
+!-
+  DO ik=1,2
+    l_uld = (ik /= 1)
+    IF (l_uld) THEN
+      it1=itmin; it2=itmax;
+    ELSE
+      it1=1; it2=1;
+    ENDIF
+    DO it=it1,it2
+      DO iv=1,f_v_nb
+        IF (    (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) &
+ &          .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN
+          CYCLE
+        ENDIF
+        IF (i_v_lev >= 3) THEN
+          WRITE (UNIT=*,FMT='("")')
+          IF (l_uld) THEN
+            WRITE (UNIT=*,FMT=*) "time step     : ",it
+          ENDIF
+          WRITE (UNIT=*,FMT=*) "variable      : ",TRIM(f_v_nm(iv))
+          WRITE (UNIT=*,FMT=*) "var unlim dim : ",v_d_ul(iv)
+        ENDIF
+!------ do the variable contains dimensions to be recombined ?
+        l_cgd = .FALSE.
+        i_n = 1
+        DO i=1,SIZE(d_d_i)
+          l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i))
+          l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i))
+          IF (l_cgd) THEN
+            i_n = f_nb_in
+              EXIT
+          ENDIF
+        ENDDO
+        IF (v_d_nb(iv) > 0) THEN
+!-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm
+          i = v_d_nb(iv)
+          ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i))
+!-------- Default definition of io_i,io_n,io_sm,io_cm
+          io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv));
+          ia_sm(:) = 1; io_sm(:) = 1;
+          IF (v_d_ul(iv) > 0) THEN
+            io_i(v_d_ul(iv))=it
+            io_n(v_d_ul(iv))=1
+            io_sm(v_d_ul(iv))=it
+          ENDIF
+          io_cm(:) = io_n(:);
+!-------- If needed, allocate offset
+          l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+          IF (TRIM(c_d_n) == "apple") THEN
+            ALLOCATE(ia_sf(i),io_sf(i),io_cf(i))
+            ALLOCATE(ia_sl(i),io_sl(i),io_cl(i))
+            ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
+            ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
+            IF (v_d_ul(iv) > 0) THEN
+              io_sf(v_d_ul(iv))=it
+              io_sl(v_d_ul(iv))=it
+            ENDIF
+          ENDIF
+        ENDIF
+!------
+        DO i_i=1,i_n
+          IF (l_cgd) THEN
+!---------- the variable contains dimensions to be recombined
+!-----------
+!---------- open each file containing a small piece of data
+            CALL flrb_of (i_i,f_id_i)
+!-----------
+!---------- do the variable has offset at first/last block ?
+            l_cof = .FALSE.; l_col = .FALSE.;
+            IF (TRIM(c_d_n) == "apple") THEN
+              L_BF: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_cof = (d_h_s(i,i_i) /= 0)
+                    IF (l_cof)  EXIT L_BF
+                  ENDIF
+                ENDDO
+              ENDDO L_BF
+              L_BL: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_col = (d_h_e(i,i_i) /= 0)
+                    IF (l_col)  EXIT L_BL
+                  ENDIF
+                ENDDO
+              ENDDO L_BL
+            ENDIF
+!---------- if needed, redefine start and count for dimensions
+            l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+            DO id=1,v_d_nb(iv)
+              DO i=1,SIZE(d_d_i)
+                IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                  io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
+                  ia_sm(id) = 1
+                  io_sm(id) = d_p_f(i,i_i)
+                  io_cm(id) = io_n(id)
+                  IF     (TRIM(c_d_n) == "box") THEN
+                    ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
+                    io_sm(id) = io_sm(id)+d_h_s(i,i_i)
+                    io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
+                  ELSEIF (TRIM(c_d_n) == "apple") THEN
+                    IF (l_cof) THEN
+                      IF (d_h_s(i,i_i) /= 0) THEN
+                        ia_sf(id) = 1+d_h_s(i,i_i)
+                        io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
+                        io_cf(id) = io_n(id)-d_h_s(i,i_i)
+                      ELSE
+                        io_sf(id) = d_p_f(i,i_i)
+                        io_cf(id) = 1
+                        ia_sm(id) = ia_sm(id)+1
+                        io_sm(id) = io_sm(id)+1
+                        io_cm(id) = io_cm(id)-1
+                        l_o_f = .TRUE.
+                      ENDIF
+                    ENDIF
+                    IF (l_col) THEN
+                      IF (d_h_e(i,i_i) /= 0) THEN
+                        ia_sl(id) = 1
+                        io_sl(id) = d_p_f(i,i_i)
+                        io_cl(id) = io_n(id)-d_h_e(i,i_i)
+                      ELSE
+                        io_cm(id) = io_cm(id)-1
+                        ia_sl(id) = 1+io_n(id)-1
+                        io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
+                        io_cl(id) = 1
+                        l_o_l = .TRUE.
+                      ENDIF
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDDO
+            ENDDO
+            l_o_m = ALL(io_cm > 0)
+          ELSE
+!---------- the data can be read/write in one piece
+            f_id_i = f_id_i1
+          ENDIF
+!---------
+          IF (i_v_lev >= 3) THEN
+            WRITE (UNIT=*,FMT=*) &
+ &            TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
+            WRITE (UNIT=*,FMT=*) "io_i  : ",io_i(:)
+            WRITE (UNIT=*,FMT=*) "io_n  : ",io_n(:)
+            WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f
+            IF (l_o_f) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_m : ",l_o_m
+            IF (l_o_m) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l
+            IF (l_o_l) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:)
+            ENDIF
+          ENDIF
+!---------
+!-------- Cases according to the type, shape and offsets of the data
+!---------
+          SELECT CASE (v_type(iv))
+!?INTEGERS of KIND 1 are not supported on all computers
+!?        CASE (flio_i1) !--- INTEGER 1
+!?          SELECT CASE (v_d_nb(iv))
+!?          CASE (0) !--- Scalar
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
+!?            CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
+!?          CASE (1) !--- 1d array
+!?            ALLOCATE(i1_1d(io_n(1)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_1d)
+!?          CASE (2) !--- 2d array
+!?            ALLOCATE(i1_2d(io_n(1),io_n(2)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_2d)
+!?          CASE (3) !--- 3d array
+!?            ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_3d)
+!?          CASE (4) !--- 4d array
+!?            ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_4d)
+!?          CASE (5) !--- 5d array
+!?            ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_5d)
+!?          END SELECT
+!?        CASE (flio_i2) !--- INTEGER 2
+          CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i2_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i2_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_5d)
+            END SELECT
+          CASE (flio_i4) !--- INTEGER 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_5d)
+            END SELECT
+          CASE (flio_r4) !--- REAL 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_5d)
+            END SELECT
+          CASE (flio_r8) !--- REAL 8
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r8_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r8_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_5d)
+            END SELECT
+          END SELECT
+!-------- eventually close each file containing a small piece of data
+          CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
+        ENDDO
+!------ If needed, deallocate io_* arrays
+        IF (v_d_nb(iv) > 0) THEN
+          DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
+          IF (TRIM(c_d_n) == "apple") THEN
+            DEALLOCATE(ia_sf,io_sf,io_cf)
+            DEALLOCATE(ia_sl,io_sl,io_cl)
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+!-------------------
+! Ending the work
+!-------------------
+!-
+! Close files
+  CALL flrb_cf (0,.TRUE.)
+!-
+! Deallocate
+  DEALLOCATE(f_nm,f_a_id)
+  DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
+  DEALLOCATE(f_d_i,f_d_l)
+  DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
+  DEALLOCATE(d_d_i,d_s_g)
+  DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
+!-
+  IF (i_v_lev >= 1) THEN
+!-- elapsed and cpu time computation
+    CALL cpu_time (t_cpu_end)
+    CALL system_clock(count=nb_cc_end)
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
+ &   REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
+    WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
+ &   t_cpu_end-t_cpu_ini
+  ENDIF
+!=======
+CONTAINS
+!=======
+SUBROUTINE flrb_of (i_f_n,i_f_i)
+!---------------------------------------------------------------------
+! Open the file of number "i_f_n" if necessary,
+! and returns its identifier in "i_f_i".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN)  :: i_f_n
+  INTEGER,INTENT(OUT) :: i_f_i
+!---------------------------------------------------------------------
+  IF (f_a_id(i_f_n) < 0) THEN
+    CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
+    f_a_id(i_f_n) = i_f_i
+  ELSE
+    i_f_i = f_a_id(i_f_n)
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_of
+!===
+SUBROUTINE flrb_cf (i_f_n,l_cf)
+!---------------------------------------------------------------------
+! Close the file of number "i_f_n" if "l_cf" is TRUE.
+! Close all files if "i_f_n <= 0".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_f_n
+  LOGICAL,INTENT(IN) :: l_cf
+!---------------------------------------------------------------------
+  IF (i_f_n <= 0) THEN
+    CALL flioclo ()
+    f_a_id(:) = -1
+  ELSE
+    IF (l_cf) THEN
+      IF (f_a_id(i_f_n) < 0) THEN
+        CALL ipslerr (2,"flio_rbld", &
+ &       "The file",TRIM(f_nm(i_f_n)),"is already closed")
+      ELSE
+        CALL flioclo (f_a_id(i_f_n))
+        f_a_id(i_f_n) = -1
+      ENDIF
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_cf
+!===
+SUBROUTINE flrb_rg
+!---------------------------------------------------------------------
+! Update valid_min valid_max attributes values
+!---------------------------------------------------------------------
+  INTEGER :: k,j
+  LOGICAL :: l_vmin,l_vmax
+  INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
+  REAL(KIND=r_4) :: r4_vmin,r4_vmax
+  REAL(KIND=r_8) :: r8_vmin,r8_vmax
+!---------------------------------------------------------------------
+  DO k=1,f_v_nb
+!-- get attribute informations
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
+!---
+    IF (l_vmin.OR.l_vmax) THEN
+!---- get values of min/max
+      SELECT CASE (a_type)
+      CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d)
+            IF (j == 1) THEN
+              i4_vmin = i4_0d
+            ELSE
+              i4_vmin = MIN(i4_vmin,i4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
+            IF (j == 1) THEN
+              i4_vmax = i4_0d
+            ELSE
+              i4_vmax = MAX(i4_vmax,i4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
+        ENDIF
+      CASE (flio_r4) !--- REAL 4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
+            IF (j == 1) THEN
+              r4_vmin = r4_0d
+            ELSE
+              r4_vmin = MIN(r4_vmin,r4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
+            IF (j == 1) THEN
+              r4_vmax = r4_0d
+            ELSE
+              r4_vmax = MAX(r4_vmax,r4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
+        ENDIF
+      CASE (flio_r8) !--- REAL 8
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
+            IF (j == 1) THEN
+              r8_vmin = r8_0d
+            ELSE
+              r8_vmin = MIN(r8_vmin,r8_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
+            IF (j == 1) THEN
+              r8_vmax = r8_0d
+            ELSE
+              r8_vmax = MAX(r8_vmax,r8_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
+        ENDIF
+      END SELECT
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE flrb_rg
+!===
+!--------------------
+END PROGRAM flio_rbld
Index: IOIPSL/tags/v2_1_9/tools/ncregular.f90
===================================================================
--- IOIPSL/tags/v2_1_9/tools/ncregular.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/ncregular.f90	(revision 715)
@@ -0,0 +1,328 @@
+PROGRAM ncregular
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This code replaces a 2D surface grid by vectors.
+!- Obviously it only works if you have a regular grid.
+!-
+!- Jan Polcher (polcher@lmd.jussieu.fr)
+!- Jacques Bellier (jacques.bellier@cea.fr)
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: iread, if, in, iv, sz
+  INTEGER :: ier, nb_files, iret, ndims, nvars, nb_glat
+  INTEGER :: lon_dim_id, lat_dim_id
+  INTEGER :: lon_len, lat_len, lon_id, lat_id
+  INTEGER :: nav_lon_id, nav_lat_id
+  INTEGER :: alloc_stat_lon, alloc_stat_lat
+!-
+  INTEGER,ALLOCATABLE ::  file_id(:), tax_id(:)
+  CHARACTER(LEN=80),ALLOCATABLE :: names(:)
+  CHARACTER(LEN=80) :: dim_name
+  CHARACTER(LEN=80) :: varname
+  CHARACTER(LEN=20) :: xname, yname, lonname, latname
+  LOGICAL :: check, regular
+!-
+  REAL,ALLOCATABLE :: lon(:), lat(:), lon2(:), lat2(:)
+  REAL,ALLOCATABLE :: del_lon(:), del_lat(:)
+!-
+  INTEGER iargc, getarg
+  EXTERNAL iargc, getarg
+!---------------------------------------------------------------------
+  alloc_stat_lon = 0
+  alloc_stat_lat = 0
+!-
+  iread = iargc()
+!-
+  ALLOCATE (names(iread),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate names of size ', iread
+    STOP 'nctax'
+  ENDIF
+!-
+  CALL nct_getarg (iread, nb_files, names, check, &
+ &                 xname, yname, lonname, latname)
+!-
+! Allocate space
+!-
+  ALLOCATE (file_id(nb_files),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate file_id of size ', nb_files
+    STOP 'nctax'
+  ENDIF
+!-
+  ALLOCATE (tax_id(nb_files),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate tax_id of size ', nb_files
+    STOP 'nctax'
+  ENDIF
+!-
+  DO if=1,nb_files
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : ', if,  names(if)
+    ENDIF
+!---
+    iret = NF90_OPEN (names(if),NF90_WRITE,file_id(if))
+    iret = NF90_INQUIRE (file_id(if),ndims,nvars,nb_glat,tax_id(if))
+!---
+!-- Get the IDs of the variables
+!---
+    lon_len = -9999
+    lat_len = -9999
+    DO in=1,ndims
+!-----
+      iret = NF90_INQUIRE_DIMENSION (file_id(if), in, dim_name, sz)
+!-----
+      IF (     (LEN_TRIM(dim_name) == 1) &
+ &        .AND.(INDEX(dim_name,TRIM(xname)) == 1) ) THEN
+        lon_dim_id = in
+        lon_len = sz
+      ENDIF
+!-----
+      IF (     (LEN_TRIM(dim_name) == 1) &
+ &        .AND.(INDEX(dim_name,TRIM(yname)) == 1) ) THEN
+        lat_dim_id = in
+        lat_len = sz
+      ENDIF
+!-----
+    ENDDO
+!---
+    IF ( (lon_len == -9999).OR.(lat_len == -9999) ) THEN
+      WRITE(*,*) 'ncregular : The specified dimensions were not'
+      WRITE(*,*) 'found in file : ',names(if)
+      iret = NF90_CLOSE (file_id(if))
+      STOP
+    ENDIF
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : lon_dim_id, lon_len',lon_dim_id,lon_len
+      WRITE(*,*) 'ncregular : lat_dim_id, lat_len',lat_dim_id,lat_len
+    ENDIF
+!---
+!-- Look for the right variables
+!---
+    nav_lon_id = -9999
+    nav_lat_id = -9999
+    DO iv=1,nvars
+      iret = NF90_INQUIRE_VARIABLE (file_id(if),iv,name=varname)
+      IF (INDEX(varname,TRIM(lonname)) > 0) THEN
+        nav_lon_id = iv
+      ENDIF
+      IF (INDEX(varname,TRIM(latname)) > 0) THEN
+        nav_lat_id = iv
+      ENDIF
+    ENDDO
+!---
+    IF ( (nav_lon_id == -9999).OR.(nav_lat_id == -9999) ) THEN
+      WRITE(*,*) 'ncregular : The specified coordinate fields'
+      WRITE(*,*) 'were not found in file : ',names(if)
+      iret = NF90_CLOSE (file_id(if))
+      STOP
+    ENDIF
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : nav_lon_id :', nav_lon_id
+      WRITE(*,*) 'ncregular : nav_lat_id :', nav_lat_id
+    ENDIF
+!---
+!-- Read variables from file and check if regular
+!---
+!-- Do we have the variable to read the
+!---
+    IF ( alloc_stat_lon < lon_len) THEN
+      IF ( alloc_stat_lon > 0) THEN
+        deallocate(lon)
+        deallocate(lon2)
+        deallocate(del_lon)
+      ENDIF
+      allocate(lon(lon_len))
+      allocate(lon2(lon_len))
+      allocate(del_lon(lon_len))
+      alloc_stat_lon = lon_len
+    ENDIF
+!---
+    IF ( alloc_stat_lat < lat_len) THEN
+      IF ( alloc_stat_lat > 0) THEN
+        deallocate(lat)
+        deallocate(lat2)
+        deallocate(del_lat)
+      ENDIF
+      allocate(lat(lat_len))
+      allocate(lat2(lat_len))
+      allocate(del_lat(lat_len))
+      alloc_stat_lat = lat_len
+    ENDIF
+!---
+!-- Read data
+!---
+    iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon, &
+ & start=(/1,1/),count=(/lon_len,1/),stride=(/1,1/))
+    iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon2, &
+ & start=(/1,int(lat_len/2)/),count=(/lon_len,1/),stride=(/1,1/))
+    del_lon = lon-lon2
+!-
+    iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat, &
+ & start=(/1,1/),count=(/1,lat_len/),stride=(/lon_len,1/))
+    iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat2, &
+ & start=(/int(lon_len/2),1/),count=(/1,lat_len/),stride=(/lon_len,1/))
+    del_lat = lat-lat2
+!-
+    regular = (    (MAXVAL(del_lon) < 0.001) &
+ &             .OR.(MAXVAL(del_lat) < 0.001) )
+!---
+!-- Create the new variables
+!---
+    IF (regular) THEN
+      IF (check) THEN
+        WRITE(*,*) 'Regular case'
+      ENDIF
+      iret = NF90_REDEF (file_id(if))
+      iret = NF90_RENAME_DIM (file_id(if), lon_dim_id, 'lon')
+      iret = NF90_RENAME_DIM (file_id(if), lat_dim_id, 'lat')
+      IF (check) THEN
+        WRITE(*,*) 'Dimensions renamed'
+      ENDIF
+      iret = NF90_DEF_VAR (file_id(if), 'lon', NF90_FLOAT, &
+ &                         lon_dim_id, lon_id)
+      iret = NF90_DEF_VAR (file_id(if), 'lat', NF90_FLOAT, &
+ &                         lat_dim_id, lat_id)
+      IF (check) THEN
+        WRITE(*,*) 'New variables defined'
+      ENDIF
+!-----
+!---- Copy attributes
+!-----
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'units', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'title', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_max', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_min', &
+ &                          file_id(if),lon_id)
+!-----
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'units', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'title', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_max', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_min', &
+ &                          file_id(if),lat_id)
+!-----
+!---- Go into write mode
+!-----
+      iret = NF90_ENDDEF (file_id(if))
+!-----
+!---- Write data
+!-----
+      iret = NF90_PUT_VAR (file_id(if),lon_id,lon(1:lon_len))
+      iret = NF90_PUT_VAR (file_id(if),lat_id,lat(1:lat_len))
+!-
+      iret = NF90_CLOSE (file_id(if))
+    ELSE
+      WRITE(*,*) 'ncregular : Your grid is not regular'
+      WRITE(*,*) names(if), 'remains unchanged'
+      iret = NF90_CLOSE (file_id(if))
+    ENDIF
+!-
+  ENDDO
+!--------------------
+END PROGRAM ncregular
+!-
+!===
+!-
+SUBROUTINE nct_getarg (argx, nb_files, names, check, &
+ &                     xname, yname, lonname, latname)
+!---------------------------------------------------------------------
+!- Read the arguments of nctax.
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in) :: argx
+  INTEGER, INTENT(out) :: nb_files
+  CHARACTER(LEN=80),INTENT(out) :: names(argx)
+  CHARACTER(LEN=20) :: xname, yname, lonname, latname
+!-
+  CHARACTER(LEN=80) :: tmp, tmp_arg
+  LOGICAL :: check
+!---------------------------------------------------------------------
+  check = .FALSE.
+!-
+! Get the number of arguments
+!-
+  nb_files = 0
+!-
+  xname = 'x'
+  yname = 'y'
+  lonname = 'nav_lon'
+  latname = 'nav_lat'
+!-
+! Go through the arguments and analyse them one by one
+!-
+  IF (check) WRITE(*,*) 'Start going through the arguments'
+!-
+  IF (argx == 0) THEN
+    WRITE(*,*) 'To get usage : nctax -h '
+    STOP
+  ENDIF
+!-
+  iread = 1
+  DO WHILE (iread <= argx)
+    iret = getarg(iread,tmp)
+    IF (check) WRITE(*,*) ' iread, tmp :', iread, tmp
+    SELECTCASE(tmp)
+      CASE('-d')
+        WRITE(*,*) 'DEBUG MODE SELECTED'
+        check = .TRUE.
+        iread = iread+1
+      CASE('-h')
+        WRITE(*,*) 'Usage : nregular [options] file1 [file2 ...]'
+        WRITE(*,*) '    -d : Verbose mode'
+        WRITE(*,*) '    -h : This output'
+        STOP
+      CASE('-dim_lon')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        xname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-dim_lat')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        yname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-coo_lon')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        lonname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-coo_lat')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        latname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE DEFAULT
+        IF (check) WRITE(*,*) 'nct_getarg : CASE default'
+        IF (INDEX(tmp,'-') /= 1) THEN
+          nb_files = nb_files+1
+          names(nb_files) = tmp
+          iread = iread+1
+        ELSE
+          WRITE(*,*) "WARNING Unknown option ",tmp
+          WRITE(*,*) "For ore information : nctax -h"
+        ENDIF
+    END SELECT
+  ENDDO
+!-
+  IF (check) THEN
+    WRITE(*,*) ' nct_getarg : output >> '
+    WRITE(*,*) '>> nb_files : ', nb_files
+    WRITE(*,*) '>> names :', (names(ii), ii=1,nb_files)
+  ENDIF
+!------------------------
+END SUBROUTINE nct_getarg
Index: IOIPSL/tags/v2_1_9/tools/ncunderflow.f90
===================================================================
--- IOIPSL/tags/v2_1_9/tools/ncunderflow.f90	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/ncunderflow.f90	(revision 715)
@@ -0,0 +1,393 @@
+MODULE declare
+! -*- Mode: f90 -*-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+! f90 -L/usr/local/lib -lnetcdf -align dcommons -g
+!     -ladebug -check format -check bounds
+!     -check output_conversion -fpe1
+!     -I/usr/local/include -free -arch host -tune host
+!     -warn declarations -warn argument_checking
+!     ncunderflow.f  -o ncunderflow
+!
+! ifc -FR -cl,ncunderflow.pcl -o ncunderflow ncunderflow.f
+!     -L/usr/local/install/netcdf/lib/libnetcdf.a -lPEPCF90
+!
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: r4 = 4, r8 = 8, i4 = 4, i8 = 8
+  INTEGER, PARAMETER :: il = KIND(1)
+  LOGICAL :: ldebug = .FALSE.
+  INTEGER (kind = il) :: nout = 0, nerr = 0         ! Standard output, standard error
+  CHARACTER (LEN=4), PARAMETER :: cerror = 'VOID'
+END MODULE declare
+!!
+MODULE mod_nfdiag
+CONTAINS
+  SUBROUTINE nfdiag ( kios, clmess, lcd)
+    !!
+    !! Imprime un message d'erreur NetCDF
+    !!
+    USE declare
+    IMPLICIT NONE
+    INCLUDE 'netcdf.inc'
+    !!
+    INTEGER (kind=i4), INTENT (in) :: kios
+    CHARACTER (len = *), INTENT (in) :: clmess
+    LOGICAL, INTENT (in), OPTIONAL :: lcd 
+    CHARACTER (len = 80) :: clt
+    LOGICAL :: ld
+    !!
+    IF ( PRESENT ( lcd)) THEN
+        ld = lcd
+    ELSE
+        ld = ldebug
+    ENDIF
+    !!
+    clt = TRIM ( NF_STRERROR ( kios) )
+    !!
+    IF ( ld ) THEN 
+        IF ( kios == NF_NOERR ) THEN 
+            WRITE ( unit = nout, fmt = * ) "OK : ", TRIM (clmess)
+        ELSE
+            WRITE ( unit = nout, fmt = * ) "ERROR : ", TRIM (clmess), " : ", TRIM ( clt), " : ", kios
+            IF ( .NOT. ld ) STOP
+        END IF
+    ELSE
+        IF ( kios /= NF_NOERR ) THEN 
+            WRITE ( unit = nout, fmt = * ) "ERROR : ", TRIM (clmess), " : ", TRIM ( clt), " : ", kios
+            STOP
+        END IF
+    ENDIF
+    !!
+    RETURN
+    !!
+  END SUBROUTINE nfdiag
+  !!
+END MODULE mod_nfdiag
+
+MODULE mod_lec
+CONTAINS
+  !!
+  SUBROUTINE lec (chaine, cval, c_c)
+    !!
+    USE declare
+    IMPLICIT NONE
+    !!
+    CHARACTER (len = *), INTENT ( inout) :: chaine
+    CHARACTER (len = *), INTENT ( inout) :: cval
+    CHARACTER (len=*), OPTIONAL :: c_c
+    INTEGER (kind = il) :: ji, ji1, ji2, ji3, jl, jb
+    INTEGER (kind = i4) :: index
+    !!
+    !! Read character string up to ':' or ',', or in c_c if present
+    !! Returns the real before the character (xerror if not available)
+    !! Reduce the string
+    !!
+    jl = LEN (chaine) ; jb = LEN_TRIM (chaine)
+    IF ( ldebug) WRITE ( nout, *) 'Lec : jl, jb ', jl, jb
+    IF ( jb == 0 ) THEN 
+        cval = cerror
+    ELSE
+        ji1 = INDEX (chaine, ':') ; ji2 = INDEX (chaine, ',')
+        IF ( PRESENT (c_c)) THEN 
+            ji3 = INDEX (chaine, c_c) ; ji = MAX (ji1, ji2, ji3)
+        ELSE
+            ji = MAX (ji1, ji2)
+        ENDIF
+        IF ( ji == 0 ) THEN 
+            READ ( chaine (1:jb) , fmt = * ) cval
+            chaine (1:jl-jb) = chaine (jb+1:jl)
+        ELSE IF ( ji == 1 ) THEN 
+            cval = cerror
+            chaine (1:jl-1) = chaine (2:jl)
+        ELSE
+            cval = chaine (1:ji-1)
+            chaine (1:jl-ji) = chaine (ji+1:jl )
+        END IF
+    END IF
+    !!
+  END SUBROUTINE lec
+END MODULE mod_lec
+
+PROGRAM ncunderflow
+
+  ! Ce programme ouvre un fichier de donnees au format netcdf
+  ! et met a zero toutes les valeurs trop petites pour etre
+  ! representees par un reel sur 4 octets au format IEEE
+  !
+  ! Revision 2.0  2004/04/05 14:47:50  adm
+  ! JB+MAF+AC: switch to IOIPSL 2.0 (1)
+  !
+  ! Revision 1.1  2003/04/09 15:21:56  adm
+  ! add ncunderflow in IOIPSL
+  ! and modify AA_make to take it into account
+  ! SD + MAF
+  !
+  ! Revision 1.1  2001/02/07  14:36:07  jypeter
+  ! J-Y Peterschmitt / LMCE / 07/02/2001
+  ! Initial revision
+  !
+  USE declare
+  USE mod_nfdiag
+  USE mod_lec
+  IMPLICIT NONE
+
+  INCLUDE 'netcdf.inc'
+
+  INTEGER (kind=il), EXTERNAL :: iargc
+
+  ! Nombre maximal de dimensions : 6
+
+  INTEGER (kind=il), PARAMETER :: jpmaxdim = 6, jpmaxvar = 1024
+
+  CHARACTER (len = 128) :: clnomprog, clnomfic
+  CHARACTER (len = 1024) :: clistvar, clecline
+  CHARACTER (len = 128), DIMENSION(jpmaxdim) :: clnomdim
+  CHARACTER (len = 128), DIMENSION(jpmaxvar) :: clvarcmd, clvarfic, clvar ! Nom des variables dans le fichier est sur la ligne de commande.
+  LOGICAL :: lrever = .FALSE. ! Si .true., on traite toutes les variables sauf celle de la ligne de commande
+  LOGICAL :: lnocoord = .FALSE. ! Si .truee., on exclu les variables coordonnées
+  LOGICAL :: lverbose = .TRUE.
+  
+  INTEGER (kind=il) :: incid, ircode, ivarid, ivartype, inbdim, inbatt
+  INTEGER (kind=il) :: nvarcmd, nvarfic, nvar, nfile, jvarcmd, jvarfic, jvar, jfile, ierr
+  INTEGER (kind=il) :: ji, jdim3, jdim4, jdim5, jdim6, j1, j2, j3, jarg, ncumul
+  INTEGER (kind=il), DIMENSION(jpmaxdim) :: idimid, idimsize, istart, icount
+  REAL (kind=r4), DIMENSION(:,:), ALLOCATABLE :: zdatacorr
+  REAL (kind=r8), DIMENSION(:,:), ALLOCATABLE :: zdata
+  REAL (kind=r4) :: reps = TINY (1.0_r4) * 10.0_r4
+  LOGICAL :: lok
+
+  ! Verification du nombre de parametres
+  IF(iargc() .LT. 2) THEN
+      CALL usage
+      STOP
+  ENDIF
+
+  ! Aide
+  jarg = 1
+  Lab1: DO WHILE ( jarg <= 3 )
+    IF (ldebug) WRITE(nout,*) 'lecture ligne commande ', jarg
+    CALL getarg (jarg,clecline)
+    IF ( clecline(1:1) /= '-' ) EXIT Lab1
+    IF ( clecline(1:2) == '-h' .OR. clecline(1:2) == '-?'  ) THEN
+        CALL usage
+        STOP 
+    ELSE IF ( clecline(1:2) == '-x' ) THEN
+        lrever = .TRUE. 
+    ELSE IF ( clecline(1:2) == '-d' ) THEN
+        ldebug = .TRUE. 
+    ELSE IF ( clecline(1:2) == '-V' ) THEN
+        lverbose = .FALSE. 
+    ELSE IF ( clecline(1:2) == '-v' ) THEN
+        jarg = jarg + 1
+        ! Recuperation des noms de variables
+        IF (ldebug) WRITE(nout,*) 'lecture liste vriables ', jarg
+        CALL getarg (jarg,clistvar)
+        clistvar = TRIM(ADJUSTL(clistvar))
+        jvarcmd = 0 ; nvarcmd = 0
+        SeekVar: DO WHILE ( .TRUE. )
+          CALL lec ( clistvar, clvarcmd(jvarcmd+1)(:) )
+          IF ( TRIM(clvarcmd(jvarcmd+1)(:)) == cerror ) EXIT SeekVar
+          jvarcmd = jvarcmd + 1
+          nvarcmd = jvarcmd
+          IF (ldebug) WRITE(nout,*) 'affecte variable ', jvarcmd, TRIM(clvarcmd(jvarcmd))
+        END DO SeekVar
+    ENDIF
+    jarg = jarg + 1
+  END DO Lab1
+
+  ! Boucle sur les fichiers
+  FileLoop: DO jfile = jarg, iargc()
+    
+    ! Recuperation du nom du fichier a traiter
+    CALL getarg ( jfile, clnomfic)
+    
+    ! Ouverture du fichier
+    CALL nfdiag ( NF_OPEN ( TRIM(clnomfic), NF_WRITE, incid ), "Opening " // TRIM(clnomfic) )
+    WRITE (nout,*) TRIM(clnomfic)
+
+    ! Recuparation de la liste des variables du fichier
+    nvarfic = 0
+    DO jvarfic = 1, jpmaxvar
+      j3 = NF_INQ_VAR ( incid, jvarfic, clvarfic(jvarfic)(:), ivartype, inbdim, idimid, inbatt)
+      IF ( j3 /= NF_NOERR ) EXIT
+      nvarfic = jvarfic
+    END DO
+
+    ! Liste des variables a traiter
+    IF ( lrever ) THEN
+        IF ( nvarcmd == 0) THEN 
+            clvar = clvarfic
+            nvar  = nvarfic
+        ELSE 
+            jvar = 0
+            DO jvarfic = 1, nvarfic
+              lok = .TRUE.
+              DO jvarcmd = 1, nvarcmd
+                IF ( TRIM(clvarfic(jvarfic)(:)) == TRIM(clvarcmd(jvarcmd)(:)) ) THEN
+                    lok = .FALSE.
+                END IF
+              END DO
+              IF ( lok) THEN 
+                  jvar = jvar + 1
+                  clvar(jvar) = clvarfic(jvarfic)
+              END IF
+            END DO
+            nvar = jvar
+        END IF
+    ELSE
+        clvar = clvarcmd
+        nvar  = nvarcmd
+    END IF
+
+    ncumul = 0
+    VarLoop: DO jvar = 1, nvar 
+      
+      IF (lverbose) &
+         & WRITE(nout, FMT='("Correction de ", A, " dans ", A, " : ", $)') TRIM(clvar(jvar)(:)), TRIM(clnomfic)
+
+      ! Passage de netcdf en mode 'erreurs non fatales'
+      !  CALL ncpopt(NCVERBOS)
+      ! En fait, on reste dans le mode par defaut, dans lequel une erreur
+      ! netcdf cause un arret du programme. Du coup, il n'est pas
+      ! necessaire de tester la valeur de la variable ircode
+      ! ATTENTION! Si jamais on veut arreter le programme a cause d'une
+      ! erreur ne provenant pas de netcdf, il faut penser a fermer
+      ! manuellement le fichier avec un appel a ncclos
+      
+      ! Recuperation de l'identificateur de la variable
+      CALL nfdiag ( NF_INQ_VARID ( incid, TRIM(clvar(jvar)(:)), ivarid), "Get var id " // TRIM(clvar(jvar)(:)))
+
+      ivartype = 0 ; idimid = 0 ; inbdim = 0 ; inbatt = 0
+      ! Recuperation du nombre de dimensions de la variable
+      CALL nfdiag ( NF_INQ_VAR ( incid, ivarid, clvar(jvar)(:), ivartype, inbdim, idimid, inbatt),  &
+         & "Get var info " // TRIM(clvar(jvar)(:)))
+      
+      IF(inbdim .GT. jpmaxdim) THEN
+          WRITE(nout,*)
+          WRITE(nout, *) 'La variable ', TRIM(clvar(jvar)(:)), ' a trop de dimensions'
+          CALL nfdiag ( NF_CLOSE (incid), "Closing file")
+          STOP
+      ENDIF
+      
+      ! Recuperation des dimensions effectives
+      idimsize(3:jpmaxdim) = 1 ! Au cas ou la variable n'ait que
+      ! 2 ou 3 dims, on initialise ces valeurs
+      ! qui serviront dans le controle des boucles
+      ! et qui auraient une valeur indefinie sinon
+      DO ji = 1, inbdim
+        CALL nfdiag ( NF_INQ_DIM ( incid, idimid(ji), clnomdim(ji), idimsize(ji)), "NF_INQ_DIM")
+        IF (lverbose) WRITE(nout, '(A,A,A,I3,$)') '    ', TRIM(clnomdim(ji)), ' = ', idimsize(ji)
+        IF ( idimsize(ji) == 0 ) THEN
+            WRITE(nout, '(A,A,A,A,I3)') TRIM(clvar(jvar)(:)), ', ', TRIM(clnomdim(ji)), ' = ', idimsize(ji)
+            CYCLE VarLoop
+        END IF
+      ENDDO
+      IF (lverbose) WRITE(nout,*)
+      idimsize = MAX ( idimsize, 1)
+      ncumul = ncumul + 1
+      
+      ! Determination du type de la variable, en fonction du nom de
+      ! la premiere dimension
+!$$$  IF(INDEX(TRIM(clnomdim(1)),'ongitude') .NE. 0) THEN
+!$$$      ! var de type map ou 3d
+!$$$      write(nout, *) '  --> MAP/3D'
+!$$$  ELSE IF(INDEX(TRIM(clnomdim(1)),'atitude') .NE. 0) THEN
+!$$$      ! var de type xsec 
+!$$$      write(nout, *) '  --> XSEC'
+!$$$  ELSE
+!$$$      WRITE(nout, *)
+!$$$      WRITE(nout, *) 'Bizarre, la premiere dimension n''est ni "longitude" ni "latitude"'
+!$$$      CALL ncclos(incid, ircode)
+!$$$      STOP
+!$$$  ENDIF
+
+      ! Reservation de memoire pour charger et traiter
+      ! une grille idimsize(1)*idimsize(2) de la variable
+      ALLOCATE(zdata(idimsize(1), idimsize(2)), stat=ierr)
+      IF(ierr .NE. 0) THEN
+          WRITE(nout, *) 'Erreur d''allocation memoire pour zdata'
+          CALL nfdiag ( NF_CLOSE (incid), "NF_CLOSE")
+          STOP
+      ENDIF
+      ALLOCATE(zdatacorr(idimsize(1), idimsize(2)), stat=ierr)
+      IF(ierr .NE. 0) THEN
+          WRITE(nout, *) 'Erreur d''allocation memoire pour zdatacorr'
+          CALL nfdiag ( NF_CLOSE (incid), "NF_CLOSE")
+          STOP
+      ENDIF
+
+      ! Parametrisation de la partie de la variable a charger en memoire
+      ! (une 'grille' que l'on lira autant de fois qu'il y a de niveaux et
+      !  de pas de temps)
+      ! Rappel : seuls les elements 1..inbdim des tableaux sont
+      ! significatifs et utiles
+
+      icount = 0
+      
+      DO jdim6 = 1, idimsize(6)
+        DO jdim5 = 1, idimsize(5)
+          DO jdim4 = 1, idimsize(4)
+            DO jdim3 = 1, idimsize(3)
+              istart = (/   1        ,      1      , jdim3, jdim4, jdim5, jdim6 /)
+              icount = (/ idimsize(1),  idimsize(2),   1  ,  1   ,  1   ,  1    /)
+
+              ! Chargement d'une 'grille' de donnees, en real*8
+              CALL nfdiag ( NF_GET_VARA_DOUBLE(incid, ivarid, istart(1:inbdim), icount(1:inbdim), zdata), &
+                 & "NF_GET_VARA_DOUBLE")
+              ! Mise a zero de toutes les valeurs trop petites pour etre
+              ! representees par un reel sur 4 octets au format IEEE.
+              ! Le truc est de faire une operation nulle (addition de 0)
+              ! sur des donnees qui posent problemes, EN AYANT COMPILE LE PROG
+              ! AVEC l'OPTION "-fpe1". Dans ce cas, les valeurs trop petites
+              ! sont remplacees par zero (0.0) et le programme continue,
+              ! au lieu de planter.
+              ! Il est possible de faire afficher le nb de valeurs qui ont pose
+              ! un pb en utilisant en plus l'option "-check underflow"
+              zdata = zdata + 0.0_r8
+              zdatacorr = REAL(zdata, KIND=r4)
+              WHERE ( ABS (zdatacorr) < reps) zdatacorr = 0.0_r4
+              
+              ! Sauvegarde de la grille corrigee dans le fichier
+              ! (a la place de la grille initiale), en real*4
+              CALL nfdiag ( NF_PUT_VARA_REAL(incid, ivarid, istart, icount, zdatacorr), "NF_PUT_VARA_REAL" )
+              
+            END DO
+          END DO
+        END DO
+      END DO
+      
+      DEALLOCATE ( zdata)
+      DEALLOCATE ( zdatacorr)
+      
+    END DO VarLoop
+    
+    WRITE (nout,*) 'ncunderflow, nombre de variables corrigees : ', ncumul
+
+    ! Fermeture du fichier
+    CALL nfdiag ( NF_CLOSE (incid), "Closing" )
+    
+  END DO FileLoop
+
+CONTAINS
+  SUBROUTINE usage
+    IMPLICIT NONE
+    CALL getarg (0, clnomprog)
+
+    WRITE(nout, FMT='("Command : ", A)') TRIM(clnomprog)
+    WRITE(nout, FMT='("Removes underflows in NetCDF files") ')
+    WRITE(nout, FMT='("Usage : ", A, " [-x] [-V] [-d] -v nomvar[,nomvar] nomfic [nomfic]")' ) TRIM(clnomprog)
+    WRITE(nout, FMT='("Options : ")' )
+    WRITE(nout, FMT='("  -V : mode verbose off. Default is verbose on.")' )
+    WRITE(nout, FMT='("  -d : debug mode on. Default is debug off.")' )
+    WRITE(nout, FMT='("  -v : gives list of variables to be corrected, separated by a coma.")' )
+    WRITE(nout, FMT='("  -x : reverses meaning of -v : given variable are not corrected")' )
+    WRITE(nout, FMT='("       if -x is given, and not -v, all variables are corrected.")' )
+    
+    
+    STOP
+  END SUBROUTINE usage
+  
+END PROGRAM ncunderflow
Index: IOIPSL/tags/v2_1_9/tools/rebuild
===================================================================
--- IOIPSL/tags/v2_1_9/tools/rebuild	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/rebuild	(revision 715)
@@ -0,0 +1,109 @@
+#!/bin/ksh
+#
+#$Id$
+#
+# This software is governed by the CeCILL license
+# See IOIPSL/IOIPSL_License_CeCILL.txt
+#---------------------------------------------------------------------
+# @(#)Rebuild IOIPSL domains
+#---------------------------------------------------------------------
+function rebuild_Usage
+{
+print - "
+\"${b_n}\"
+  rebuild a model_file from several input files.
+Each input file contains the model_data for a domain.
+
+Usage :
+  ${b_n} [-h]
+  ${b_n} [-v level] [-f] -o output_file_name input_file_names
+
+Options :
+  -h         : help
+  -v O/1/2/3 : verbose mode (verbosity increasing with level)
+  -f         : executing mode
+               (execute the program even if the number of input files
+                is not equal to the total number of domains)
+"
+}
+#-
+#set -xv
+#-
+# Extract the calling sequence of the script (d_n/b_n)
+#-
+d_n=${0%/*}; b_n=${0##*/};
+#-
+# Retrieving the options
+#-
+r_v='0'; r_f='noforce'; r_o="";
+while getopts :hv:fo: V
+ do
+  case $V in
+   (h) rebuild_Usage; exit 0;;
+   (v) r_v=${OPTARG};;
+   (f) r_f='force';;
+   (o) r_o=${OPTARG};;
+   (:) print -u2 "${b_n} : missing value for option $OPTARG"; exit 2;;
+   (\?) print -u2 "${b_n} : option $OPTARG not supported"; exit 2;;
+  esac
+ done
+shift $(($OPTIND-1));
+#-
+# Validate the -v option
+#-
+case ${r_v} in
+  ( 0 | 1 | 2 | 3 );;
+  ("") r_v='0';;
+  (*)
+    print -u2 "${b_n} :";
+    print -u2 "Invalid verbosity level requested : ${r_v}";
+    print -u2 "(must be 0, 1, 2 or 3)";
+    exit 1;;
+esac
+#-
+# Validate the number of arguments
+#-
+[[ ${#} < 1 ]] && \
+ {
+  print -u2 "${b_n} : Too few arguments have been specified. (Use -h)";
+  exit 3;
+ }
+#-
+# Check for the output file name
+#-
+[[ -z ${r_o} ]] && \
+ {
+  r_o='rebuilt_file.nc';
+  print -u2 - "
+   ${b_n} : output_file_name not specified. (Use -h)
+            rebuilt_file.nc should be created."
+ }
+#-
+# Validate the names of the input files
+#-
+for i in $*;
+ do
+  [[ ! -f ${i} ]] && { echo "${i} unreachable ..."; exit 3;}
+ done
+#-
+# Create the information file for the program
+#-
+echo ${r_v} > tmp.$$;
+echo ${r_f} >> tmp.$$;
+echo $((${#}+1)) >> tmp.$$;
+for i in $*;
+ do echo ${i} >> tmp.$$;
+ done
+echo ${r_o} >> tmp.$$;
+#-
+# Create the output file
+#-
+${d_n}/flio_rbld < tmp.$$
+#-
+# Clear
+#-
+rm -f tmp.$$
+#-
+# End
+#-
+exit 0;
Index: IOIPSL/tags/v2_1_9/tools/tkcond.c
===================================================================
--- IOIPSL/tags/v2_1_9/tools/tkcond.c	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/tkcond.c	(revision 715)
@@ -0,0 +1,546 @@
+/* parser config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * The general idea here is that we want to parse a config.in file and 
+ * from this, we generate a wish script which gives us effectively the
+ * same functionality that the original config.in script provided.
+ *
+ * This task is split roughly into 3 parts.  The first parse is the parse
+ * of the input file itself.  The second part is where we analyze the 
+ * #ifdef clauses, and attach a linked list of tokens to each of the
+ * menu items.  In this way, each menu item has a complete list of
+ * dependencies that are used to enable/disable the options.
+ * The third part is to take the configuration database we have build,
+ * and build the actual wish script.
+ *
+ * This file contains the code to further process the conditions from
+ * the "ifdef" clauses.
+ *
+ * The conditions are assumed to be one of the following formats
+ *
+ * simple_condition:= "$VARIABLE" == y/n/m
+ * simple_condition:= "$VARIABLE != y/n/m
+ *
+ * simple_condition -a simple_condition
+ *
+ * If the input condition contains '(' or ')' it would screw us up, but for now
+ * this is not a problem.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "tkparse.h"
+
+
+/*
+ * Walk a condition chain and invert it so that the logical result is
+ * inverted.
+ */
+static void invert_condition(struct condition * cnd)
+{
+  /*
+   * This is simple.  Just walk through the list, and invert
+   * all of the operators.
+   */
+  for(;cnd; cnd = cnd->next)
+    {
+      switch(cnd->op)
+	{
+	case op_and:
+	  cnd->op = op_or;
+	  break;
+	case op_or:
+	  /*
+	   * This is not turned into op_and - we need to keep track
+	   * of what operators were used here since we have an optimization
+	   * later on to remove duplicate conditions, and having
+	   * inverted ors in there would make it harder if we did not
+	   * distinguish an inverted or from an and we inserted because
+	   * of nested ifs.
+	   */
+	  cnd->op = op_and1;
+	  break;
+	case op_neq:
+	  cnd->op = op_eq;
+	  break;
+	case op_eq:
+	  cnd->op = op_neq;
+	  break;
+	default:
+	  break;
+	}
+    }
+}
+
+/*
+ * Walk a condition chain, and free the memory associated with it.
+ */
+static void free_condition(struct condition * cnd)
+{
+  struct condition * next;
+  for(;cnd; cnd = next)
+    {
+      next = cnd->next;
+
+      if( cnd->variable.str != NULL )
+	free(cnd->variable.str);
+
+      free(cnd);
+    }
+}
+
+/*
+ * Walk all of the conditions, and look for choice values.  Convert
+ * the tokens into something more digestible.
+ */
+void fix_choice_cond()
+{
+  struct condition * cond;
+  struct condition * cond2;
+  struct kconfig * cfg;
+  char tmpbuf[10];
+
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->cond == NULL )
+	{
+	  continue;
+	}
+
+      for(cond = cfg->cond; cond != NULL; cond = cond->next)
+	{
+	  if( cond->op != op_kvariable )
+	    continue;
+
+	  if( cond->variable.cfg->tok != tok_choice )
+	    continue;
+
+	  /*
+	   * Look ahead for what we are comparing this to.  There should
+	   * be one operator in between.
+	   */
+	  cond2 = cond->next->next;
+	  strcpy(tmpbuf, cond->variable.cfg->label);
+
+	  if( strcmp(cond2->variable.str, "y") == 0 )
+	    {
+	      cond->variable.cfg = cond->variable.cfg->choice_label;
+	      cond2->variable.str = strdup(tmpbuf);
+	    }
+	  else
+	    {
+	      fprintf(stderr,"Ooops\n");
+	      exit(0);
+	    }
+	}
+
+    }
+}
+
+/*
+ * Walk the stack of conditions, and clone all of them with "&&" operators
+ * gluing them together.  The conditions from each level of the stack
+ * are wrapped in parenthesis so as to guarantee that the results
+ * are logically correct.
+ */
+struct condition * get_token_cond(struct condition ** cond, int depth)
+{
+  int i;
+  struct condition * newcond;
+  struct condition * tail;
+  struct condition * new;
+  struct condition * ocond;
+  struct kconfig * cfg;
+
+  newcond = tail = NULL;
+  for(i=0; i<depth; i++, cond++)
+    {
+      /*
+       * First insert the left parenthesis
+       */
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = op_lparen;
+      if( tail == NULL )
+	{
+	  newcond = tail = new;
+	}
+      else
+	{
+	  tail->next = new;
+	  tail = new;
+	}
+
+      /*
+       * Now duplicate the chain.
+       */
+      ocond = *cond;
+      for(;ocond != NULL; ocond = ocond->next)
+	{
+	  new = (struct condition *) malloc(sizeof(struct condition));
+	  memset(new, 0, sizeof(*new));
+	  new->op = ocond->op;
+	  if( ocond->variable.str != NULL )
+	    {
+	      if( ocond->op == op_variable )
+		{
+		  /*
+		   * Search for structure to insert here.
+		   */
+		  for(cfg = config;cfg != NULL; cfg = cfg->next)
+		    {
+		      if( cfg->tok != tok_bool
+		         && cfg->tok != tok_int
+		         && cfg->tok != tok_hex
+			 && cfg->tok != tok_tristate 
+			 && cfg->tok != tok_choice
+			 && cfg->tok != tok_dep_tristate)
+			{
+			  continue;
+			}
+		      if( strcmp(cfg->optionname, ocond->variable.str) == 0)
+			{
+			  new->variable.cfg = cfg;
+			  new->op = op_kvariable;
+			  break;
+			}
+		    }
+		  if( cfg == NULL )
+		    {
+		      new->variable.str = strdup(ocond->variable.str);
+		    }
+		}
+	      else
+		{
+		  new->variable.str = strdup(ocond->variable.str);
+		}
+	    }
+	  tail->next = new;
+	  tail = new;
+	}
+
+      /*
+       * Next insert the left parenthesis
+       */
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = op_rparen;
+      tail->next = new;
+      tail = new;
+
+      /*
+       * Insert an and operator, if we have another condition.
+       */
+      if( i < depth - 1 )
+	{
+	  new = (struct condition *) malloc(sizeof(struct condition));
+	  memset(new, 0, sizeof(*new));
+	  new->op = op_and;
+	  tail->next = new;
+	  tail = new;
+	}
+
+    }
+
+  return newcond;
+}
+
+/*
+ * Walk a single chain of conditions and clone it.  These are assumed
+ * to be created/processed by  get_token_cond in a previous pass.
+ */
+struct condition * get_token_cond_frag(struct condition * cond, 
+				       struct condition ** last)
+{
+  struct condition * newcond;
+  struct condition * tail;
+  struct condition * new;
+  struct condition * ocond;
+
+  newcond = tail = NULL;
+
+  /*
+   * Now duplicate the chain.
+   */
+  for(ocond = cond;ocond != NULL; ocond = ocond->next)
+    {
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = ocond->op;
+      new->variable.cfg = ocond->variable.cfg;
+      if( tail == NULL )
+	{
+	  newcond = tail = new;
+	}
+      else
+	{
+	  tail->next = new;
+	  tail = new;
+	}
+    }
+
+  new = (struct condition *) malloc(sizeof(struct condition));
+  memset(new, 0, sizeof(*new));
+  new->op = op_and;
+  tail->next = new;
+  tail = new;
+  
+  *last = tail;
+  return newcond;
+}
+
+/*
+ * Walk through the if conditionals and maintain a chain.
+ */
+void fix_conditionals(struct kconfig * scfg)
+{
+  int depth = 0;
+  int i;
+  struct kconfig * cfg;
+  struct kconfig * cfg1;
+  struct condition * conditions[25];
+  struct condition * cnd;
+  struct condition * cnd1;
+  struct condition * cnd2;
+  struct condition * cnd3;
+  struct condition * newcond;
+  struct condition * last;
+
+  /*
+   * Start by walking the chain.  Every time we see an ifdef, push
+   * the condition chain on the stack.  When we see an "else", we invert
+   * the condition at the top of the stack, and when we see an "endif"
+   * we free all of the memory for the condition at the top of the stack
+   * and remove the condition from the top of the stack.
+   *
+   * For any other type of token (i.e. a bool), we clone a new condition chain
+   * by anding together all of the conditions that are currently stored on
+   * the stack.  In this way, we have a correct representation of whatever
+   * conditions govern the usage of each option.
+   */
+  memset(conditions, 0, sizeof(conditions));
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch(cfg->tok)
+	{
+	case tok_if:
+	  /*
+	   * Push this condition on the stack, and nuke the token
+	   * representing the ifdef, since we no longer need it.
+	   */
+	  conditions[depth] = cfg->cond;
+	  depth++;
+	  cfg->tok = tok_nop;
+	  cfg->cond =  NULL;
+	  break;
+	case tok_else:
+	  /*
+	   * For an else, we just invert the condition at the top of
+	   * the stack.  This is done in place with no reallocation
+	   * of memory taking place.
+	   */
+	  invert_condition(conditions[depth-1]);
+	  cfg->tok = tok_nop;
+	  break;
+	case tok_fi:
+	  depth--;
+	  free_condition(conditions[depth]);
+	  conditions[depth] = NULL;
+	  cfg->tok = tok_nop;
+	  break;
+	case tok_comment:
+	case tok_define:
+	case tok_menuoption:
+	case tok_bool:
+	case tok_tristate:
+	case tok_int:
+	case tok_hex:
+	case tok_choice:
+	case tok_make:
+	  /*
+	   * We need to duplicate the chain of conditions and attach them to
+	   * this token.
+	   */
+	  cfg->cond = get_token_cond(&conditions[0], depth);
+	  break;
+	case tok_dep_tristate:
+	  /*
+	   * Same as tok_tristate et al except we have a temporary
+	   * conditional. (Sort of a hybrid tok_if, tok_tristate, tok_fi
+	   * option)
+	   */
+	  conditions[depth] = cfg->cond;
+	  depth++;
+	  cfg->cond = get_token_cond(&conditions[0], depth);
+	  depth--;
+	  free_condition(conditions[depth]);
+	  conditions[depth] = NULL;
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Fix any conditions involving the "choice" operator.
+   */
+  fix_choice_cond();
+
+  /*
+   * Walk through and see if there are multiple options that control the
+   * same kvariable.  If there are we need to treat them a little bit
+   * special.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch(cfg->tok)
+	{
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	  for(cfg1=cfg;cfg1 != NULL; cfg1 = cfg1->next)
+	    {
+	      switch(cfg1->tok)
+		{
+		case tok_define:
+		case tok_bool:
+		case tok_tristate:
+		case tok_dep_tristate:
+		case tok_int:
+		case tok_hex:
+		  if( strcmp(cfg->optionname, cfg1->optionname) == 0)
+		    {
+		      cfg->flags |= CFG_DUP;
+		      cfg1->flags |= CFG_DUP;
+		    }
+		  break;
+		default:
+		  break;
+		}
+	    }
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Now go through the list, and every time we see a kvariable, check
+   * to see whether it also has some dependencies.  If so, then
+   * append it to our list.  The reason we do this is that we might have
+   * option CONFIG_FOO which is only used if CONFIG_BAR is set.  It may
+   * turn out that in config.in that the default value for CONFIG_BAR is
+   * set to "y", but that CONFIG_BAR is not enabled because CONFIG_XYZZY
+   * is not set.  The current condition chain does not reflect this, but
+   * we can fix this by searching for the tokens that this option depends
+   * upon and cloning the conditions and merging them with the list.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Search for a token that has a condition list.
+       */
+      if(cfg->cond == NULL) continue;
+      for(cnd = cfg->cond; cnd; cnd=cnd->next)
+	{
+	  /*
+	   * Now search the condition list for a known configuration variable
+	   * that has conditions of its own.
+	   */
+	  if(cnd->op != op_kvariable) continue;
+	  if(cnd->variable.cfg->cond == NULL) continue;
+
+	  if(cnd->variable.cfg->flags & CFG_DUP) continue; 
+	  /*
+	   * OK, we have some conditions to append to cfg.  Make  a clone
+	   * of the conditions,
+	   */
+	  newcond = get_token_cond_frag(cnd->variable.cfg->cond, &last);
+
+	  /*
+	   * Finally, we splice it into our list.
+	   */
+	  last->next = cfg->cond;
+	  cfg->cond = newcond;
+
+	}
+    }
+
+  /*
+   * There is a strong possibility that we have duplicate conditions
+   * in here.  It would make the script more efficient and readable to
+   * remove these.  Here is where we assume here that there are no
+   * parenthesis in the input script.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Search for configuration options that have conditions.
+       */
+      if(cfg->cond == NULL) continue;
+      for(cnd = cfg->cond; cnd; cnd=cnd->next)
+	{
+	  /*
+	   * Search for a left parenthesis.
+	   */
+	  if(cnd->op != op_lparen) continue;
+	  for(cnd1 = cnd->next; cnd1; cnd1=cnd1->next)
+	    {
+	      /*
+	       * Search after the previous left parenthesis, and try
+	       * and find a second left parenthesis.
+	       */
+	      if(cnd1->op != op_lparen) continue;
+
+	      /*
+	       * Now compare the next 5 tokens to see if they are
+	       * identical.  We are looking for two chains that
+	       * are like: '(' $VARIABLE operator constant ')'.
+	       */
+	      cnd2 = cnd;
+	      cnd3 = cnd1;
+	      for(i=0; i<5; i++, cnd2=cnd2->next, cnd3=cnd3->next)
+		{
+		  if(!cnd2 || !cnd3) break;
+		  if(cnd2->op != cnd3->op) break;
+		  if(i == 1 && (cnd2->op != op_kvariable 
+		     || cnd2->variable.cfg != cnd3->variable.cfg) ) break;
+		  if(i==2 && cnd2->op != op_eq && cnd2->op != op_neq) break;
+		  if(i == 3 && cnd2->op != op_constant &&
+		     strcmp(cnd2->variable.str, cnd3->variable.str) != 0)
+		    break;
+		  if(i==4 && cnd2->op != op_rparen) break;
+		}
+	      /*
+	       * If these match, and there is an and gluing these together,
+	       * then we can nuke the second one.
+	       */
+	      if(i==5 && ((cnd3 && cnd3->op == op_and)
+			  ||(cnd2 && cnd2->op == op_and)))
+		{
+		  /*
+		   * We have a duplicate.  Nuke 5 ops.
+		   */
+		  cnd3 = cnd1;
+		  for(i=0; i<5; i++, cnd3=cnd3->next)
+		    {
+		      cnd3->op = op_nuked;
+		    }
+		  /*
+		   * Nuke the and that glues the conditions together.
+		   */
+		  if(cnd3 && cnd3->op == op_and) cnd3->op = op_nuked;
+		  else if(cnd2 && cnd2->op == op_and) cnd2->op = op_nuked;
+		}
+	    }
+	}
+    }
+}
Index: IOIPSL/tags/v2_1_9/tools/tkgen.c
===================================================================
--- IOIPSL/tags/v2_1_9/tools/tkgen.c	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/tkgen.c	(revision 715)
@@ -0,0 +1,1136 @@
+/* Generate tk script based upon config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * 1996 01 04
+ * Avery Pennarun - Aesthetic improvements.
+ *
+ * 1996 01 24
+ * Avery Pennarun - Bugfixes and more aesthetics.
+ *
+ * 1996 03 08
+ * Avery Pennarun - The int and hex config.in commands work right.
+ *                - Choice buttons are more user-friendly.
+ *                - Disabling a text entry line greys it out properly.
+ *                - dep_tristate now works like in Configure. (not pretty)
+ *                - No warnings in gcc -Wall. (Fixed some "interesting" bugs.)
+ *                - Faster/prettier "Help" lookups.
+ *
+ * 1996 03 15
+ * Avery Pennarun - Added new sed script from Axel Boldt to make help even
+ *                  faster. (Actually awk is downright slow on some machines.)
+ *                - Fixed a bug I introduced into Choice dependencies.  Thanks
+ *                  to Robert Krawitz for pointing this out.
+ *
+ * 1996 03 16
+ * Avery Pennarun - basic "do_make" support added to let sound config work.
+ *
+ * 1996 03 25
+ *     Axel Boldt - Help now works on "choice" buttons.
+ *
+ * 1996 04 06
+ * Avery Pennarun - Improved sound config stuff. (I think it actually works
+ *                  now!)
+ *                - Window-resize-limits don't use ugly /usr/lib/tk4.0 hack.
+ *                - int/hex work with tk3 again. (The "cget" error.)
+ *                - Next/Prev buttons switch between menus.  I can't take
+ *                  much credit for this; the code was already there, but
+ *                  ifdef'd out for some reason.  It flickers a lot, but
+ *                  I suspect there's no "easy" fix for that.
+ *                - Labels no longer highlight as you move the mouse over
+ *                  them (although you can still press them... oh well.)
+ *                - Got rid of the last of the literal color settings, to
+ *                  help out people with mono X-Windows systems. 
+ *                  (Apparently there still are some out there!)
+ *                - Tabstops seem sensible now.
+ *
+ * 1996 04 14
+ * Avery Pennarun - Reduced flicker when creating windows, even with "update
+ *                  idletasks" hack.
+ *
+ * TO DO:
+ *   - clean up - there are useless ifdef's everywhere.
+ *   - better comments throughout - C code generating tcl is really cryptic.
+ *   - eliminate silly "update idletasks" hack to improve display speed and
+ *     reduce flicker.  But how?
+ *   - make canvas contents resize with the window (good luck).
+ *   - some way to make submenus inside of submenus (ie. Main->Networking->IP)
+ *           (perhaps a button where the description would be)
+ *   - make the main menu use the same tcl code as the submenus.
+ *   - make choice and int/hex input types line up vertically with
+ *           bool/tristate.
+ *   - general speedups - how?  The canvas seems to slow it down a lot.
+ *   - choice buttons should default to the first menu option, rather than a
+ *           blank.  Also look up the right variable when the help button
+ *           is pressed.
+ *   - clean up +/- 16 confusion for enabling/disabling variables; causes
+ *           (theoretical, at the moment) problems with dependencies.
+ *   
+ */
+#include <stdio.h>
+#include <unistd.h>
+#include "tkparse.h"
+
+#ifndef TRUE
+#define TRUE (1)
+#endif
+
+#ifndef FALSE
+#define FALSE (0)
+#endif
+
+/*
+ * This is the total number of submenus that we have.
+ */
+static int tot_menu_num =0;
+
+/*
+ * Generate portion of wish script for the beginning of a submenu.
+ * The guts get filled in with the various options.
+ */
+static void start_proc(char * label, int menu_num, int flag)
+{
+  if( flag )
+    printf("menu_option menu%d %d \"%s\"\n", menu_num, menu_num, label);
+  printf("proc menu%d {w title} {\n", menu_num);
+  printf("\tcatch {destroy $w}\n");
+  printf("\ttoplevel $w -class Dialog\n");
+  printf("\twm withdraw $w\n");
+  printf("\tmessage $w.m -width 400 -aspect 300 -text \\\n");
+  printf("\t\t\"%s\"  -relief raised\n",label);
+  printf("\tpack $w.m -pady 10 -side top -padx 10\n");
+  printf("\twm title $w \"%s\" \n\n", label);
+  
+  /*
+   * Attach the "Prev", "Next" and "OK" buttons at the end of the window.
+   */
+  printf("\tset oldFocus [focus]\n");
+  printf("\tframe $w.f\n");
+  printf("\tbutton $w.f.back -text \"Main Menu\" \\\n"
+         "\t\t-width 15 -command \"destroy $w; focus $oldFocus; update_mainmenu $w\"\n");
+  printf("\tbutton $w.f.next -text \"Next\" \\\n"
+         "\t\t-width 15 -command \" destroy $w; focus $oldFocus;  menu%d .menu%d \\\"$title\\\"\"\n",
+         	menu_num+1, menu_num+1);
+  if (menu_num == tot_menu_num)
+  	printf("\t$w.f.next configure -state disabled\n");
+  printf("\tbutton $w.f.prev -text \"Prev\" \\\n"
+         "\t\t-width 15 -command \" destroy $w; focus $oldFocus; menu%d .menu%d \\\"$title\\\"\"\n",
+       		menu_num-1, menu_num-1);
+  if (1 == menu_num)
+  	printf("\t$w.f.prev configure -state disabled\n");
+  printf("\tpack $w.f.back $w.f.next $w.f.prev -side left -expand on\n");
+  printf("\tpack $w.f -pady 10 -side bottom -anchor w -fill x\n");
+
+  /*
+   * Lines between canvas and other areas of the window.
+   */
+  printf("\tframe $w.topline -relief ridge -borderwidth 2 -height 2\n");
+  printf("\tpack $w.topline -side top -fill x\n\n");
+  printf("\tframe $w.botline -relief ridge -borderwidth 2 -height 2\n");
+  printf("\tpack $w.botline -side bottom -fill x\n\n");
+  
+  /*
+   * The "config" frame contains the canvas and a scrollbar.
+   */
+  printf("\tframe $w.config\n");
+  printf("\tpack $w.config -fill y -expand on\n\n");
+  printf("\tscrollbar $w.config.vscroll -command \"$w.config.canvas yview\"\n");
+  printf("\tpack $w.config.vscroll -side right -fill y\n\n");
+  
+  /*
+   * The scrollable canvas itself, where the real work (and mess) gets done.
+   */
+  printf("\tcanvas $w.config.canvas -height 1\\\n"
+  	 "\t\t-relief flat -borderwidth 0 -yscrollcommand \"$w.config.vscroll set\" \\\n"
+  	 "\t\t-width [expr [winfo screenwidth .] * 1 / 2] \n");
+  printf("\tframe $w.config.f\n");
+  printf("\tpack $w.config.canvas -side right -fill y\n");
+  
+  printf("\n\n");
+}
+
+/*
+ * Each proc we create needs a global declaration for any global variables we
+ * use.  To minimize the size of the file, we set a flag each time we output
+ * a global declaration so we know whether we need to insert one for a
+ * given function or not.
+ */
+void clear_globalflags(struct kconfig * cfg)
+{
+  for(; cfg != NULL; cfg = cfg->next)
+  {
+    cfg->flags &= ~GLOBAL_WRITTEN;
+  }
+}
+
+/*
+ * Output a "global" line for a given variable.  Also include the
+ * call to "vfix".  (If vfix is not needed, then it's fine to just printf
+ * a "global" line).
+ */
+void global(char *var)
+{
+  printf("\tglobal %s; vfix %s\n", var, var);
+}
+
+/*
+ * This function walks the chain of conditions that we got from cond.c,
+ * and creates a wish conditional to enable/disable a given widget.
+ */
+void generate_if(struct kconfig * item,
+	    struct condition * cond,
+	    int menu_num,
+	    int line_num)
+{
+  struct condition * ocond;
+
+  ocond = cond;
+
+  /*
+   * First write any global declarations we need for this conditional.
+   */
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_variable:
+      	global(cond->variable.str);
+	break;
+      case op_kvariable:
+	if(cond->variable.cfg->flags & GLOBAL_WRITTEN) break;
+	cond->variable.cfg->flags |= GLOBAL_WRITTEN;
+	global(cond->variable.cfg->optionname);
+	break;
+      default:
+	break;
+      }
+      cond = cond->next;
+    }
+  
+  /*
+   * Now write this option.
+   */
+  if(   (item->flags & GLOBAL_WRITTEN) == 0
+     && (item->optionname != NULL) )
+    {
+      global(item->optionname);
+      item->flags |= GLOBAL_WRITTEN;
+    }
+  /*
+   * Now generate the body of the conditional.
+   */
+  printf("\tif {");
+  cond = ocond;
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_eq:
+	printf(" == ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+      case op_and1:
+	printf(" && ");
+	break;
+      case op_or:
+	printf(" || ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_kvariable:
+	printf("$%s", cond->variable.cfg->optionname);
+	break;
+      case op_shellcmd:
+	printf("[exec %s]", cond->variable.str);
+	break;
+      case op_constant:
+	if( strcmp(cond->variable.str, "y") == 0 )
+	  printf("1");
+	else if( strcmp(cond->variable.str, "n") == 0 )
+	  printf("0");
+	else if( strcmp(cond->variable.str, "m") == 0 )
+	  printf("2");
+	else
+	  printf("\"%s\"", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  /*
+   * Now we generate what we do depending upon the value of the conditional.
+   * Depending upon what the token type is, there are different things
+   * we must do to enable/disable the given widget - this code needs to
+   * be closely coordinated with the widget creation procedures in header.tk.
+   */
+  switch(item->tok)
+    {
+    case tok_define:
+      printf("} then { set %s %s } \n",  item->optionname, item->value);
+      break;
+    case tok_menuoption:
+      printf("} then { .f0.x%d configure -state normal } else { .f0.x%d configure -state disabled }\n",
+	     menu_num, menu_num);
+      break;
+    case tok_int:
+    case tok_hex:
+      printf("} then { ");
+      printf(".menu%d.config.f.x%d.x configure -state normal -fore [ cget .ref -foreground ]; ", menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal; ", menu_num, line_num);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.x configure -state disabled -fore [ cget .ref -disabledforeground ];", menu_num, line_num );
+      printf(".menu%d.config.f.x%d.l configure -state disabled;", menu_num, line_num );
+      printf("}\n");
+      break;
+    case tok_bool:
+#ifdef BOOL_IS_BUTTON
+      /*
+       * If a bool is just a button, then use this definition.
+       */
+      printf("} then { .menu%d.config.f.x%d configure -state normal } else { .menu%d.config.f.x%d configure -state disabled }\n",
+	     menu_num, line_num,
+	     menu_num, line_num );
+#else
+      /*
+       * If a bool is a radiobutton, then use this instead.
+       */
+      printf("} then { ");
+      printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal;",menu_num, line_num);
+      printf("set %s [expr $%s&15];", item->optionname, item->optionname);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state disabled;",menu_num, line_num);
+      printf("set %s [expr $%s|16];", item->optionname, item->optionname);
+      printf("}\n");
+#endif
+      break;
+    case tok_tristate:
+    case tok_dep_tristate:
+      printf("} then { ");
+      if( item->tok == tok_dep_tristate )
+	{
+	  global(item->depend.str);
+	  printf("if { $%s != 1 && $%s != 0 } then {", 
+	  	item->depend.str,item->depend.str);
+	  printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+	  printf("} else {");
+	  printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+	  printf("}; ");
+	}
+      else
+	{
+	  printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+	}
+      
+      printf(".menu%d.config.f.x%d.n configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.m configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal;",menu_num, line_num);
+      /*
+       * Or in a bit to the variable - this causes all of the radiobuttons
+       * to be deselected (i.e. not be red).
+       */
+      printf("set %s [expr $%s&15];", item->optionname, item->optionname);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.m configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state disabled;",menu_num, line_num);
+      /*
+       * Clear the disable bit - this causes the correct radiobutton
+       * to appear selected (i.e. turn red).
+       */
+      printf("set %s [expr $%s|16];", item->optionname, item->optionname);
+      printf("}\n");
+      break;
+    case tok_choose:
+    case tok_choice:
+      fprintf(stderr,"Fixme\n");
+      exit(0);
+    default:
+      break;
+    }
+}
+
+/*
+ * Similar to generate_if, except we come here when generating an
+ * output file.  Thus instead of enabling/disabling a widget, we
+ * need to decide whether to write out a given configuration variable
+ * to the output file.
+ */
+void generate_if_for_outfile(struct kconfig * item,
+	    struct condition * cond)
+{
+  struct condition * ocond;
+
+  /*
+   * First write any global declarations we need for this conditional.
+   */
+  ocond = cond;
+  for(; cond != NULL; cond = cond->next )
+    {
+      switch(cond->op){
+      case op_variable:
+        global(cond->variable.str);
+	break;
+      case op_kvariable:
+	if(cond->variable.cfg->flags & GLOBAL_WRITTEN) break;
+	cond->variable.cfg->flags |= GLOBAL_WRITTEN;
+	global(cond->variable.cfg->optionname);
+	break;
+      default:
+	break;
+      }
+    }
+
+  /*
+   * Now generate the body of the conditional.
+   */
+  printf("\tif {");
+  cond = ocond;
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_eq:
+	printf(" == ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+      case op_and1:
+	printf(" && ");
+	break;
+      case op_or:
+	printf(" || ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_shellcmd:
+	printf("[exec %s]", cond->variable.str);
+	break;
+      case op_kvariable:
+	printf("$%s", cond->variable.cfg->optionname);
+	break;
+      case op_constant:
+	if( strcmp(cond->variable.str, "y") == 0 )
+	  printf("1");
+	else if( strcmp(cond->variable.str, "n") == 0 )
+	  printf("0");
+	else if( strcmp(cond->variable.str, "m") == 0 )
+	  printf("2");
+	else
+	  printf("\"%s\"", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  /*
+   * Now we generate what we do depending upon the value of the
+   * conditional.  Depending upon what the token type is, there are
+   * different things we must do write the value the given widget -
+   * this code needs to be closely coordinated with the widget
+   * creation procedures in header.tk.  
+   */
+  switch(item->tok)
+    {
+    case tok_define:
+      printf("} then {write_tristate $cfg $autocfg %s %s $notmod }\n", item->optionname, item->value);
+      break;
+    case tok_comment:
+      printf("} then {write_comment $cfg $autocfg \"%s\"}\n", item->label);
+      break;
+    case tok_dep_tristate:
+      printf("} then { write_tristate $cfg $autocfg %s $%s $%s } \n", 
+	     item->optionname, item->optionname, item->depend.str);
+      break;
+    case tok_tristate:
+    case tok_bool:
+      printf("} then { write_tristate $cfg $autocfg %s $%s $notmod }\n", 
+	     item->optionname, item->optionname);
+      break;
+    case tok_int:
+      printf("} then { write_int $cfg $autocfg %s $%s $notmod }\n",
+             item->optionname, item->optionname);
+      break;
+    case tok_hex:
+      printf("} then { write_hex $cfg $autocfg %s $%s $notmod }\n",
+             item->optionname, item->optionname);
+      break;
+    case tok_make:
+      printf("} then { do_make {%s} }\n",item->value);
+      break;
+    case tok_choose:
+    case tok_choice:
+      fprintf(stderr,"Fixme\n");
+      exit(0);
+    default:
+      break;
+    }
+}
+
+/*
+ * Generates a fragment of wish script that closes out a submenu procedure.
+ */
+static void end_proc(int menu_num)
+{
+  struct kconfig * cfg;
+
+  printf("\n\n\n");
+  printf("\tfocus $w\n");
+  printf("\tupdate_menu%d $w.config.f\n", menu_num);
+  printf("\tglobal winx; global winy\n");
+  printf("\tset winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]\n");
+  printf("\twm geometry $w +$winx+$winy\n");
+  
+  /*
+   * Now that the whole window is in place, we need to wait for an "update"
+   * so we can tell the canvas what its virtual size should be.
+   *
+   * Unfortunately, this causes some ugly screen-flashing because the whole
+   * window is drawn, and then it is immediately resized.  It seems
+   * unavoidable, though, since "frame" objects won't tell us their size
+   * until after an update, and "canvas" objects can't automatically pack
+   * around frames.  Sigh.
+   */
+  printf("\tupdate idletasks\n");
+  printf("\t$w.config.canvas create window 0 0 -anchor nw -window $w.config.f\n\n");
+  printf("\t$w.config.canvas configure \\\n"
+  	 "\t\t-width [expr [winfo reqwidth $w.config.f] + 1]\\\n"
+  	 "\t\t-scrollregion \"-1 -1 [expr [winfo reqwidth $w.config.f] + 1] \\\n"
+  	 "\t\t\t [expr [winfo reqheight $w.config.f] + 1]\"\n\n");
+  	 
+  /*
+   * If the whole canvas will fit in 3/4 of the screen height, do it;
+   * otherwise, resize to around 1/2 the screen and let us scroll.
+   */
+  printf("\tset winy [expr [winfo reqh $w] - [winfo reqh $w.config.canvas]]\n");
+  printf("\tset scry [expr [winfo screenh $w] / 2]\n");
+  printf("\tset maxy [expr [winfo screenh $w] * 3 / 4]\n");
+  printf("\tset canvtotal [expr [winfo reqh $w.config.f] + 2]\n");
+  printf("\tif [expr $winy + $canvtotal < $maxy] {\n"
+  	 "\t\t$w.config.canvas configure -height $canvtotal\n"
+  	 "\t} else {\n"
+  	 "\t\t$w.config.canvas configure -height [expr $scry - $winy]\n"
+  	 "\t}\n");
+  
+  /*
+   * Limit the min/max window size.  Height can vary, but not width,
+   * because of the limitations of canvas and our laziness.
+   */
+  printf("\tupdate idletasks\n");
+  printf("\twm maxsize $w [winfo width $w] [winfo screenheight $w]\n");
+  printf("\twm minsize $w [winfo width $w] 100\n\n");
+  printf("\twm deiconify $w\n");
+    
+  printf("}\n\n\n");
+
+  /*
+   * Now we generate the companion procedure for the menu we just
+   * generated.  This procedure contains all of the code to
+   * disable/enable widgets based upon the settings of the other
+   * widgets, and will be called first when the window is mapped,
+   * and each time one of the buttons in the window are clicked.
+   */
+  printf("proc update_menu%d {w}  {\n", menu_num);
+
+  printf("\tupdate_define\n");
+  clear_globalflags(config);
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if (cfg->menu_number != menu_num ) continue;
+      if (cfg->tok != tok_define) continue;
+      /*
+       * Clear all of the booleans that are defined in this menu.
+       */
+      if(   (cfg->flags & GLOBAL_WRITTEN) == 0
+	 && (cfg->optionname != NULL) )
+	{
+	  printf("\tglobal %s\n", cfg->optionname);
+	  cfg->flags |= GLOBAL_WRITTEN;
+	  printf("\tset %s 0\n", cfg->optionname);
+	}
+
+    }
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if (cfg->menu_number != menu_num ) continue;
+      if (cfg->tok == tok_menuoption) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, menu_num, cfg->menu_line);
+      else
+	{
+	  /*
+	   * If this token has no conditionals, check to see whether
+	   * it is a tristate - if so, then generate the conditional
+	   * to enable/disable the "y" button based upon the setting
+	   * of the option it depends upon.
+	   */
+	  if(cfg->tok == tok_dep_tristate)
+	    {
+	      global(cfg->depend.str);
+	      printf("\tif {$%s != 1 && $%s != 0 } then { .menu%d.config.f.x%d.y configure -state disabled } else { .menu%d.config.f.x%d.y configure -state normal}\n",
+		     cfg->depend.str,cfg->depend.str,
+		     menu_num, cfg->menu_line,
+		     menu_num, cfg->menu_line);
+	    }
+	}
+
+    }
+
+
+  printf("}\n\n\n");
+}
+
+/*
+ * This function goes through and counts up the number of items in
+ * each submenu. If there are too many options, we need to split it
+ * into submenus.  This function just calculates how many submenus,
+ * and how many items go in each submenu.
+ */
+static void find_menu_size(struct kconfig *cfg,
+			  int *menu_max, 
+			  int *menu_maxlines)
+
+{
+  struct kconfig * pnt;
+  int tot;
+  
+  /*
+   * First count up the number of options in this menu.
+   */
+  tot = 0;
+  for(pnt = cfg->next; pnt; pnt = pnt->next)
+  {
+    if( pnt->tok == tok_menuoption) break;
+    switch (pnt->tok)
+      {
+      case tok_bool:
+      case tok_tristate:
+      case tok_dep_tristate:
+      case tok_int:
+      case tok_hex:
+      case tok_choose:
+	tot++;
+	break;
+      case tok_choice:
+      default:
+	break;
+      }
+  }
+
+  *menu_max = cfg->menu_number;
+  *menu_maxlines = tot;
+}
+
+/*
+ * This is the top level function for generating the tk script.
+ */
+void dump_tk_script(struct kconfig *scfg)
+{
+  int menu_num =0;
+  int menu_max =0;
+  int menu_min =0;
+  int menu_line = 0;
+  int menu_maxlines = 0;
+  struct kconfig * cfg;
+  struct kconfig * cfg1 = NULL;
+  char * menulabel;
+
+  /*
+   * Start by assigning menu numbers, and submenu numbers.
+   */
+  for(cfg = scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuname:
+	  break;
+	case tok_menuoption:
+	  /*
+	   * At the start of a new menu, calculate the number of items
+	   * we will put into each submenu so we know when to bump the
+	   * menu number. The submenus are really no different from a
+	   * normal menu, but the top level buttons only access the first
+	   * of the chain of menus, and the prev/next buttons are used
+	   * access the submenus.
+	   */
+	  cfg->menu_number = ++menu_num;
+	  find_menu_size(cfg, &menu_max, &menu_maxlines);
+	  cfg->submenu_start = menu_num;
+	  cfg->submenu_end = menu_max;
+	  menu_line = 0;
+	  break;
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	case tok_choose:
+	  /*
+	   * If we have overfilled the menu, then go to the next one.
+	   */
+	  if( menu_line == menu_maxlines )
+	    {
+	      menu_line = 0;
+	      menu_num++;
+	    }
+	  cfg->menu_number = menu_num;
+	  cfg->submenu_start = menu_min;
+	  cfg->submenu_end = menu_max;
+	  cfg->menu_line = menu_line++;
+	  break;
+	case tok_define:
+	  cfg->menu_number = -1;
+	case tok_choice:
+	default:
+	  break;
+	};
+    }
+
+  /*
+   * Record this so we can set up the prev/next buttons correctly.
+   */
+  tot_menu_num = menu_num;
+
+  /*
+   * Now start generating the actual wish script that we will use.
+   * We need to keep track of the menu numbers of the min/max menu
+   * for a range of submenus so that we can correctly limit the
+   * prev and next buttons so that they don't go over into some other
+   * category.
+   */
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuname:
+	  printf("mainmenu_name \"%s\"\n", cfg->label);
+	  break;
+	case tok_menuoption:
+	  /*
+	   * We are at the start of a new menu. If we had one that
+	   * we were working on before, close it out, and then generate
+	   * the script to start the new one.
+	   */
+	  if( cfg->menu_number > 1 )
+	    {
+	      end_proc(menu_num);
+	    }
+	  menulabel = cfg->label;
+	  start_proc(cfg->label, cfg->menu_number, TRUE);
+	  menu_num = cfg->menu_number;
+	  menu_max = cfg->submenu_end;
+	  menu_min = cfg->submenu_start;
+	  break;
+	case tok_bool:
+	  /*
+	   * If we reached the point where we need to switch over
+	   * to the next submenu, then bump the menu number and generate
+	   * the code to close out the old menu and start the new one.
+	   */
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tbool $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+
+	case tok_choice:
+	  printf("\t$w.config.f.x%d.x.menu add radiobutton -label \"%s\" -variable %s -value \"%s\" -command \"update_menu%d .menu%d.config.f\"\n",
+		 cfg1->menu_line,
+		 cfg->label,
+		 cfg1->optionname,
+		 cfg->label,
+		 cfg1->menu_number, cfg1->menu_number);
+	  break;
+	case tok_choose:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tglobal %s\n",cfg->optionname);
+	  printf("\tminimenu $w.config.f %d %d \"%s\" %s %s\n",
+	  	cfg->menu_number,
+	  	cfg->menu_line,
+	  	cfg->label,
+	  	cfg->optionname,
+	  	/*
+	  	 * We rely on the fact that the first tok_choice corresponding
+	  	 * to the current tok_choose is cfg->next (compare parse() in
+	  	 * tkparse.c).  We need its name to pick out the right help
+	  	 * text from Configure.help.
+	  	 */
+	  	cfg->next->optionname);
+	  printf("\tmenu $w.config.f.x%d.x.menu\n", cfg->menu_line);
+	  cfg1 = cfg;
+	  break;
+	case tok_tristate:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\ttristate $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	case tok_dep_tristate:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tdep_tristate $w.config.f %d %d \"%s\" %s %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname,
+		 cfg->depend.str);
+	  break;
+	case tok_int:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tint $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	case tok_hex:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\thex $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	default:
+	  break;
+	}
+
+    }
+
+  /*
+   * Generate the code to close out the last menu.
+   */
+  end_proc(menu_num);
+
+#ifdef ERIC_DONT_DEF
+  /*
+   * Generate the code for configuring the sound driver.  Right now this
+   * cannot be done from the X script, but we insert the menu anyways.
+   */
+  start_proc("Configure sound driver", ++menu_num, TRUE);
+#if 0
+  printf("\tdo_make -C drivers/sound config\n");
+  printf("\techo check_sound_config %d\n",menu_num);
+#endif
+  printf("\tlabel $w.config.f.m0 -bitmap error\n");
+  printf("\tmessage $w.config.f.m1 -width 400 -aspect 300 -text \"The sound drivers cannot as of yet be configured via the X-based interface\" -relief raised\n");
+  printf("\tpack $w.config.f.m0 $w.config.f.m1 -side top -pady 10 -expand on\n");
+  /*
+   * Close out the last menu.
+   */
+  end_proc(menu_num);
+#endif
+
+  /*
+   * The top level menu also needs an update function.  When we exit a
+   * submenu, we may need to disable one or more of the submenus on
+   * the top level menu, and this procedure will ensure that things are
+   * correct.
+   */
+  printf("proc update_mainmenu {w}  {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuoption:
+	  if (cfg->cond != NULL ) 
+	    generate_if(cfg, cfg->cond, cfg->menu_number, cfg->menu_line);
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  printf("}\n\n\n");
+
+#if 0
+  /*
+   * Generate some code to set the variables that are "defined".
+   */
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if( cfg->tok != tok_define) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, menu_num, cfg->menu_line);
+      else
+	{
+	  printf("\twrite_define %s %s\n", cfg->optionname, cfg->value);
+	}
+
+    }
+#endif
+
+  /*
+   * Now generate code to load the default settings into the variables.
+   * Note that the script in tail.tk will attempt to load .config,
+   * which may override these settings, but that's OK.
+   */
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_choice:
+	  printf("set %s 0\n", cfg->optionname);
+	  break;
+	case tok_int:
+	case tok_hex:
+	  printf("set %s %s\n", cfg->optionname, cfg->value);
+	  break;
+	case tok_choose:
+	  printf("set %s \"(not set)\"\n",cfg->optionname);
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Next generate a function that can be called from the main menu that will
+   * write all of the variables out.  This also serves double duty - we can
+   * save configuration to a file using this.
+   */
+  printf("proc writeconfig {file1 file2} {\n");
+  printf("\tset cfg [open $file1 w]\n");
+  printf("\tset autocfg [open $file2 w]\n");
+  printf("\tset notmod 1\n");
+  printf("\tset notset 0\n");
+  clear_globalflags(config);
+  printf("\tputs $cfg \"#\"\n");
+  printf("\tputs $cfg \"# Automatically generated make config: don't edit\"\n");
+  printf("\tputs $cfg \"#\"\n");
+
+  printf("\tputs $autocfg \"/*\"\n");
+  printf("\tputs $autocfg \" * Automatically generated C config: don't edit\"\n");
+  printf("\tputs $autocfg \" */\"\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_int:
+	case tok_hex:
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_define:
+	case tok_choose:
+	  if(!(cfg->flags & GLOBAL_WRITTEN))
+	    {
+	      cfg->flags |= GLOBAL_WRITTEN;
+	      printf("\tglobal %s\n", cfg->optionname);
+	    }
+	  /* fall through */
+	case tok_make:
+	case tok_comment:
+	  if (cfg->cond != NULL ) 
+	    generate_if_for_outfile(cfg, cfg->cond);
+	  else
+	    {
+	      if(cfg->tok == tok_dep_tristate)
+		{
+		  printf("\tif {$%s == 0 } then {\n"
+		  	 "\t\twrite_tristate $cfg $autocfg %s $notset $notmod\n"
+		  	 "\t} else {\n"
+		  	 "\t\twrite_tristate $cfg $autocfg %s $%s $%s\n"
+		  	 "\t}\n",
+		  	 cfg->depend.str,
+			 cfg->optionname,
+			 cfg->optionname,
+			 cfg->optionname,
+			 cfg->depend.str);
+		}
+	      else if(cfg->tok == tok_comment)
+		{
+		  printf("\twrite_comment $cfg $autocfg \"%s\"\n", cfg->label);
+		}
+#if 0
+	      else if(cfg->tok == tok_define)
+		{
+		  printf("\twrite_define %s %s\n", cfg->optionname,
+			 cfg->value);
+		}
+#endif
+	      else if (cfg->tok == tok_choose )
+		{
+		  for(cfg1 = cfg->next; 
+		      cfg1 != NULL && cfg1->tok == tok_choice;
+		      cfg1 = cfg1->next)
+		    {
+		      printf("\tif { $%s == \"%s\" } then { write_tristate $cfg $autocfg %s 1 $notmod }\n",
+			     cfg->optionname,
+			     cfg1->label,
+			     cfg1->optionname);
+		    }
+		}
+	      else if (cfg->tok == tok_int )
+	        {
+		  printf("\twrite_int $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+	        }
+	      else if (cfg->tok == tok_hex )
+	        {
+		  printf("\twrite_hex $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+	        }
+	      else if (cfg->tok == tok_make )
+	        {
+	          printf("\tdo_make {%s}\n",cfg->value);
+	        }
+	      else
+		{
+		  printf("\twrite_tristate $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+		}
+	    }
+	  break;
+	default:
+	  break;
+	}
+    }
+  printf("\tclose $cfg\n");
+  printf("\tclose $autocfg\n");
+  printf("}\n\n\n");
+
+  /*
+   * Finally write a simple function that updates the master choice
+   * variable depending upon what values were loaded from a .config
+   * file.  
+   */
+  printf("proc clear_choices { } {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_choose ) continue;
+      for(cfg1 = cfg->next; 
+	  cfg1 != NULL && cfg1->tok == tok_choice;
+	  cfg1 = cfg1->next)
+	{
+	  printf("\tglobal %s; set %s 0\n",cfg1->optionname,cfg1->optionname);
+	}
+    }
+  printf("}\n\n\n");
+
+  printf("proc update_choices { } {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_choose ) continue;
+      printf("\tglobal %s\n", cfg->optionname);
+      for(cfg1 = cfg->next; 
+	  cfg1 != NULL && cfg1->tok == tok_choice;
+	  cfg1 = cfg1->next)
+	{
+	  printf("\tglobal %s\n", cfg1->optionname);
+	  printf("\tif { $%s == 1 } then { set %s \"%s\" }\n",
+		 cfg1->optionname,
+		 cfg->optionname,
+		 cfg1->label);
+	}
+    }
+  printf("}\n\n\n");
+
+  printf("proc update_define { } {\n");
+  clear_globalflags(config);
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_define ) continue;
+      printf("\tglobal %s; set %s 0\n",  cfg->optionname,  cfg->optionname);
+      cfg->flags |= GLOBAL_WRITTEN;
+    }
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_define ) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, -1, 0);
+      else
+	{
+	  printf("\tset %s %s\n",
+		 cfg->optionname, cfg->value);
+	}
+    }
+  printf("}\n\n\n");
+  /*
+   * That's it.  We are done.  The output of this file will have header.tk
+   * prepended and tail.tk appended to create an executable wish script.
+   */
+}
Index: IOIPSL/tags/v2_1_9/tools/tkparse.c
===================================================================
--- IOIPSL/tags/v2_1_9/tools/tkparse.c	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/tkparse.c	(revision 715)
@@ -0,0 +1,755 @@
+/* parser config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * The general idea here is that we want to parse a config.in file and 
+ * from this, we generate a wish script which gives us effectively the
+ * same functionality that the original config.in script provided.
+ *
+ * This task is split roughly into 3 parts.  The first parse is the parse
+ * of the input file itself.  The second part is where we analyze the 
+ * #ifdef clauses, and attach a linked list of tokens to each of the
+ * menu items.  In this way, each menu item has a complete list of
+ * dependencies that are used to enable/disable the options.
+ * The third part is to take the configuration database we have build,
+ * and build the actual wish script.
+ *
+ * This file contains the code to do the first parse of config.in.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "tkparse.h"
+
+struct kconfig * config = NULL;
+struct kconfig * clast = NULL;
+struct kconfig * koption = NULL;
+static int lineno = 0;
+static int menus_seen = 0;
+static char * current_file = NULL;
+static int do_source(char * filename);
+static char * get_string(char *pnt, char ** labl);
+static int choose_number = 0;
+
+
+/*
+ * Simple function just to skip over spaces and tabs in config.in.
+ */
+static char * skip_whitespace(char * pnt)
+{
+  while( *pnt && (*pnt == ' ' || *pnt == '\t')) pnt++;
+  return pnt;
+}
+
+/*
+ * This function parses a conditional from a config.in (i.e. from an ifdef)
+ * and generates a linked list of tokens that describes the conditional.
+ */
+static struct condition * parse_if(char * pnt)
+{
+  char * opnt;
+  struct condition *list;
+  struct condition *last;
+  struct condition *cpnt;
+  char varname[64];
+  char * pnt1;
+
+  opnt = pnt;
+
+  /*
+   * We need to find the various tokens, and build the linked list.
+   */
+  pnt = skip_whitespace(pnt);
+  if( *pnt != '[' ) return NULL;
+  pnt++;
+  pnt = skip_whitespace(pnt);
+
+  list = last = NULL;
+  while(*pnt && *pnt != ']') {
+
+    pnt = skip_whitespace(pnt);
+    if(*pnt== '\0' || *pnt == ']') break;
+
+    /*
+     * Allocate memory for the token we are about to parse, and insert
+     * it in the linked list.
+     */
+    cpnt = (struct condition *) malloc(sizeof(struct condition));
+    memset(cpnt, 0, sizeof(struct condition));
+    if( last == NULL )
+      {
+	list = last = cpnt;
+      }
+    else
+      {
+	last->next = cpnt;
+	last = cpnt;
+      }
+
+    /*
+     * Determine what type of operation this token represents.
+     */
+    if( *pnt == '-' && pnt[1] == 'a' )
+      {
+	cpnt->op = op_and;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '-' && pnt[1] == 'o' )
+      {
+	cpnt->op = op_or;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '!' && pnt[1] == '=' )
+      {
+	cpnt->op = op_neq;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '=')
+      {
+	cpnt->op = op_eq;
+	pnt += 1;
+	continue;
+      }
+
+    if( *pnt == '!')
+      {
+	cpnt->op = op_bang;
+	pnt += 1;
+	continue;
+      }
+
+    if( *pnt != '"' ) goto error;  /* This cannot be right. */
+    pnt++;
+    if( *pnt == '`' )
+      {
+	cpnt->op = op_shellcmd;
+	pnt1 = varname;
+	pnt++;
+	while(*pnt && *pnt != '`') *pnt1++ = *pnt++;
+	*pnt1++ = '\0';
+	cpnt->variable.str = strdup(varname);
+	if( *pnt == '`' ) pnt++;
+	if( *pnt == '"' ) pnt++;
+	continue;
+      }
+    if( *pnt == '$' )
+      {
+	cpnt->op = op_variable;
+	pnt1 = varname;
+	pnt++;
+	while(*pnt && *pnt != '"') *pnt1++ = *pnt++;
+	*pnt1++ = '\0';
+	cpnt->variable.str = strdup(varname);
+	if( *pnt == '"' ) pnt++;
+	continue;
+      }
+
+    cpnt->op = op_constant;
+    pnt1 = varname;
+    while(*pnt && *pnt != '"') *pnt1++ = *pnt++;
+    *pnt1++ = '\0';
+    cpnt->variable.str = strdup(varname);
+    if( *pnt == '"' ) pnt++;
+    continue;
+  }
+
+  return list;
+
+ error:
+  if(current_file != NULL) 
+    fprintf(stderr, 
+	    "Bad if clause at line %d(%s):%s\n", lineno, current_file, opnt);
+  else
+    fprintf(stderr,
+	    "Bad if clause at line %d:%s\n", lineno, opnt);
+  return NULL;
+}
+
+/*
+ * This function looks for a quoted string, from the input buffer, and
+ * returns a pointer to a copy of this string.  Any characters in
+ * the string that need to be "quoted" have a '\' character inserted
+ * in front - this way we can directly write these strings into
+ * wish scripts.
+ */
+static char * get_qstring(char *pnt, char ** labl)
+{
+  char quotechar;
+  char newlabel[1024];
+  char * pnt1;
+  char * pnt2;
+
+  while( *pnt && *pnt != '"' && *pnt != '\'') pnt++;
+  if (*pnt == '\0') return pnt;
+
+  quotechar = *pnt++;
+  pnt1 = newlabel;
+  while(*pnt && *pnt != quotechar && pnt[-1] != '\\')
+    {
+      /*
+       * Quote the character if we need to.
+       */
+      if( *pnt == '"' || *pnt == '\'' || *pnt == '[' || *pnt == ']')
+	*pnt1++ = '\\';
+
+      *pnt1++ = *pnt++;
+    }
+  *pnt1++ = '\0';
+
+  pnt2 = (char *) malloc(strlen(newlabel) + 1);
+  strcpy(pnt2, newlabel);
+  *labl = pnt2;
+
+  /*
+   * Skip over last quote, and whitespace.
+   */
+  pnt++;
+  pnt = skip_whitespace(pnt);
+  return pnt;
+}
+
+static char * parse_choices(struct kconfig * choice_kcfg, char * pnt)
+{
+  struct kconfig * kcfg;
+  int index = 1;
+
+  /*
+   * Choices appear in pairs of strings.  The parse is fairly trivial.
+   */
+  while(1)
+    {
+      pnt = skip_whitespace(pnt);
+      if(*pnt == '\0') break;
+
+      kcfg = (struct kconfig *) malloc(sizeof(struct kconfig));
+      memset(kcfg, 0, sizeof(struct kconfig));
+      kcfg->tok = tok_choice;
+      if( clast != NULL )
+	{
+	  clast->next = kcfg;
+	  clast = kcfg;
+	}
+      else
+	{
+	  clast = config = kcfg;
+	}
+
+      pnt = get_string(pnt, &kcfg->label);
+      pnt = skip_whitespace(pnt);
+      pnt = get_string(pnt, &kcfg->optionname);
+      kcfg->choice_label = choice_kcfg;
+      kcfg->choice_value = index++;
+      if( strcmp(kcfg->label, choice_kcfg->value) == 0 )
+	choice_kcfg->choice_value = kcfg->choice_value;
+    }
+    
+    return pnt;
+}
+
+
+/*
+ * This function grabs one text token from the input buffer
+ * and returns a pointer to a copy of just the identifier.
+ * This can be either a variable name (i.e. CONFIG_NET),
+ * or it could be the default value for the option.
+ */
+static char * get_string(char *pnt, char ** labl)
+{
+  char newlabel[1024];
+  char * pnt1;
+  char * pnt2;
+
+  if (*pnt == '\0') return pnt;
+
+  pnt1 = newlabel;
+  while(*pnt && *pnt != ' ' && *pnt != '\t')
+    {
+      *pnt1++ = *pnt++;
+    }
+  *pnt1++ = '\0';
+
+  pnt2 = (char *) malloc(strlen(newlabel) + 1);
+  strcpy(pnt2, newlabel);
+  *labl = pnt2;
+
+  if( *pnt ) pnt++;
+  return pnt;
+}
+
+
+/*
+ * Top level parse function.  Input pointer is one complete line from config.in
+ * and the result is that we create a token that describes this line
+ * and insert it into our linked list.
+ */
+void parse(char * pnt) {
+  enum token tok;
+  struct kconfig * kcfg;
+  char tmpbuf[24],fake_if[1024];
+
+  /*
+   * Ignore comments and leading whitespace.
+   */
+
+  pnt = skip_whitespace(pnt);
+  while( *pnt && (*pnt == ' ' || *pnt == '\t')) pnt++;
+  if(! *pnt ) return;
+  if( *pnt == '#' ) return;
+
+  /*
+   * Now categorize the next token.
+   */
+  tok = tok_unknown;
+  if      (strncmp(pnt, "mainmenu_name", 13) == 0) 
+    {
+      tok = tok_menuname;
+      pnt += 13;
+    }
+  else if      (strncmp(pnt, "source", 6) == 0) 
+    {
+      pnt += 7;
+      pnt = skip_whitespace(pnt);
+      do_source(pnt);
+      return;
+    }
+  else if (strncmp(pnt, "mainmenu_option", 15) == 0) 
+    {
+      menus_seen++;
+      tok = tok_menuoption;
+      pnt += 15;
+    }
+  else if (strncmp(pnt, "$MAKE ", 6) == 0) 
+    {
+      tok = tok_make;
+    }
+  else if (strncmp(pnt, "comment", 7) == 0) 
+    {
+      tok = tok_comment;
+      pnt += 7;
+    }
+  else if (strncmp(pnt, "choice", 6) == 0) 
+    {
+      tok = tok_choose;
+      pnt += 6;
+    }
+  else if (strncmp(pnt, "define_bool", 11) == 0) 
+    {
+      tok = tok_define;
+      pnt += 11;
+    }
+  else if (strncmp(pnt, "bool", 4) == 0) 
+    {
+      tok = tok_bool;
+      pnt += 4;
+    }
+  else if (strncmp(pnt, "tristate", 8) == 0) 
+    {
+      tok = tok_tristate;
+      pnt += 8;
+    }
+  else if (strncmp(pnt, "dep_tristate", 12) == 0) 
+    {
+      tok = tok_dep_tristate;
+      pnt += 12;
+    }
+  else if (strncmp(pnt, "int", 3) == 0) 
+    {
+      tok = tok_int;
+      pnt += 3;
+    }
+  else if (strncmp(pnt, "hex", 3) == 0) 
+    {
+      tok = tok_hex;
+      pnt += 3;
+    }
+  else if (strncmp(pnt, "if", 2) == 0) 
+    {
+      tok = tok_if;
+      pnt += 2;
+    }
+  else if (strncmp(pnt, "else", 4) == 0) 
+    {
+      tok = tok_else;
+      pnt += 4;
+    }
+  else if (strncmp(pnt, "fi", 2) == 0) 
+    {
+      tok = tok_fi;
+      pnt += 2;
+    }
+  else if (strncmp(pnt, "endmenu", 7) == 0) 
+    {
+      tok = tok_endmenu;
+      pnt += 7;
+    }
+
+  if( tok == tok_unknown)
+    {
+      if( clast != NULL && clast->tok == tok_if 
+	  && strcmp(pnt,"then") == 0) return;
+      if( current_file != NULL )
+	fprintf(stderr, "unknown command=%s(%s %d)\n", pnt,
+		current_file, lineno);
+      else
+	fprintf(stderr, "unknown command=%s(%d)\n", pnt,lineno);
+      return;
+    }
+
+  /*
+   * Allocate memory for this item, and attach it to the end of the linked
+   * list.
+   */
+  kcfg = (struct kconfig *) malloc(sizeof(struct kconfig));
+  memset(kcfg, 0, sizeof(struct kconfig));
+  kcfg->tok = tok;
+  if( clast != NULL )
+    {
+      clast->next = kcfg;
+      clast = kcfg;
+    }
+  else
+    {
+      clast = config = kcfg;
+    }
+
+  pnt = skip_whitespace(pnt);
+
+  /*
+   * Now parse the remaining parts of the option, and attach the results
+   * to the structure.
+   */
+  switch (tok)
+    {
+    case tok_choose:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_qstring(pnt, &kcfg->optionname);
+      pnt = get_string(pnt, &kcfg->value);
+      /*
+       * Now we need to break apart the individual options into their
+       * own configuration structures.
+       */
+      parse_choices(kcfg, kcfg->optionname);
+      free(kcfg->optionname);
+      sprintf(tmpbuf, "tmpvar_%d", choose_number++);
+      kcfg->optionname = strdup(tmpbuf);
+      break;
+    case tok_define:
+      pnt = get_string(pnt, &kcfg->optionname);
+      if(*pnt == 'y' || *pnt == 'Y' ) kcfg->value = "1";
+      if(*pnt == 'n' || *pnt == 'N' ) kcfg->value = "0";
+      if(*pnt == 'm' || *pnt == 'M' ) kcfg->value = "2";
+      break;
+    case tok_menuname:
+      pnt = get_qstring(pnt, &kcfg->label);
+      break;
+    case tok_bool:
+    case tok_tristate:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      break;
+    case tok_int:
+    case tok_hex:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      pnt = get_string(pnt, &kcfg->value);
+      break;
+    case tok_dep_tristate:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      pnt = skip_whitespace(pnt);
+      if( *pnt == '$') pnt++;
+      pnt = get_string(pnt, &kcfg->depend.str);
+
+      /*
+       * Create a conditional for this object's dependency.
+       *
+       * We can't use "!= n" because this is internally converted to "!= 0"
+       * and if UMSDOS depends on MSDOS which depends on FAT, then when FAT
+       * is disabled MSDOS has 16 added to its value, making UMSDOS fully
+       * available.  Whew.
+       *
+       * This is more of a hack than a fix.  Nested "if" conditionals are
+       * probably affected too - that +/- 16 affects things in too many
+       * places.  But this should do for now.
+       */
+      sprintf(fake_if,"[ \"$%s\" = \"y\" -o \"$%s\" = \"m\" ]; then",
+	      	kcfg->depend.str,kcfg->depend.str);
+      kcfg->cond = parse_if(fake_if);
+      if(kcfg->cond == NULL )
+	{
+	  exit(1);
+	}
+      break;
+    case tok_comment:
+      pnt = get_qstring(pnt, &kcfg->label);
+      if( koption != NULL )
+	{
+	  pnt = get_qstring(pnt, &kcfg->label);
+	  koption->label = kcfg->label;
+	  koption = NULL;
+	}
+      break;
+    case tok_menuoption:
+      if( strncmp(pnt, "next_comment", 12) == 0)
+	{
+	  koption = kcfg;
+	}
+      else
+	{
+	  pnt = get_qstring(pnt, &kcfg->label);
+	}
+      break;
+    case tok_make:
+      kcfg->value=strdup(pnt);
+      break;
+    case tok_else:
+    case tok_fi:
+    case tok_endmenu:
+      break;
+    case tok_if:
+      /*
+       * Conditionals are different.  For the first level parse, only
+       * tok_if and tok_dep_tristate items have a ->cond chain attached.
+       */
+      kcfg->cond = parse_if(pnt);
+      if(kcfg->cond == NULL )
+	{
+	  exit(1);
+	}
+      break;
+    default:
+      exit(0);
+    }
+    
+    return;
+}
+
+/*
+ * Simple function to dump to the screen what the condition chain looks like.
+ */
+void dump_if(struct condition * cond)
+{
+  printf(" ");
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_eq:
+	printf(" = ");
+	break;
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+	printf(" -a ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_constant:
+	printf("'%s'", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  printf("\n");
+}
+
+static int do_source(char * filename)
+{
+  char buffer[1024];
+  int  offset;
+  int old_lineno;
+  char * old_file;
+  char * pnt;
+  FILE * infile;
+
+  if( strcmp(filename, "-") == 0 )
+    infile = stdin;
+  else
+    infile = fopen(filename,"r");
+
+  /*
+   * If our cwd was in the scripts directory, we might have to go up one
+   * to find the sourced file.
+   */
+  if(!infile) {
+    strcpy (buffer, "../");
+    strcat (buffer, filename);
+    infile = fopen(buffer,"r");
+  }
+
+  if(!infile) {
+    fprintf(stderr,"Unable to open file %s\n", filename);
+    return 1;
+  }
+  old_lineno = lineno;
+  lineno = 0;
+  if( infile != stdin ) {
+    old_file = current_file;
+    current_file = filename;
+  }
+  offset = 0;
+  while(1)
+    {
+      fgets(&buffer[offset], sizeof(buffer) - offset, infile);
+      if(feof(infile)) break;
+
+      /*
+       * Strip the trailing return character.
+       */
+      pnt = buffer + strlen(buffer) - 1;
+      if( *pnt == '\n') *pnt-- = 0;
+      lineno++;
+      if( *pnt == '\\' )
+	{
+	  offset = pnt - buffer;
+	}
+      else
+	{
+	  parse(buffer);
+	  offset = 0;
+	}
+    }
+  fclose(infile);
+  if( infile != stdin ) {
+    current_file = old_file;
+  }
+  lineno = old_lineno;
+  return 0;
+}
+
+int main(int argc, char * argv[])
+{
+#if 0
+  char buffer[1024];
+  char * pnt;
+  struct kconfig * cfg;
+  int    i;
+#endif
+
+  /*
+   * Read stdin to get the top level script.
+   */
+  do_source("-");
+
+  if( menus_seen == 0 )
+    {
+      fprintf(stderr,"The config.in file for this platform does not support\n");
+      fprintf(stderr,"menus.\n");
+      exit(1);
+    }
+  /*
+   * Input file is now parsed.  Next we need to go through and attach
+   * the correct conditions to each of the actual menu items and kill
+   * the if/else/endif tokens from the list.  We also flag the menu items
+   * that have other things that depend upon its setting.
+   */
+  fix_conditionals(config);
+
+  /*
+   * Finally, we generate the wish script.
+   */
+  dump_tk_script(config);
+
+#if 0
+  /*
+   * Now dump what we have so far.  This is only for debugging so that
+   * we can display what we think we have in the list.
+   */
+  for(cfg = config; cfg; cfg = cfg->next)
+    {
+
+      if(cfg->cond != NULL && cfg->tok != tok_if)
+	dump_if(cfg->cond);
+
+      switch(cfg->tok)
+	{
+	case tok_menuname:
+	  printf("main_menuname ");
+	  break;
+	case tok_bool:
+	  printf("bool ");
+	  break;
+	case tok_tristate:
+	  printf("tristate ");
+	  break;
+	case tok_dep_tristate:
+	  printf("dep_tristate ");
+	  break;
+	case tok_int:
+	  printf("int ");
+	  break;
+	case tok_hex:
+	  printf("hex ");
+	  break;
+	case tok_comment:
+	  printf("comment ");
+	  break;
+	case tok_menuoption:
+	  printf("menuoption ");
+	  break;
+	case tok_else:
+	  printf("else");
+	  break;
+	case tok_fi:
+	  printf("fi");
+	  break;
+	case tok_if:
+	  printf("if");
+	  break;
+	default:
+	}
+
+      switch(cfg->tok)
+	{
+	case tok_menuoption:
+	case tok_comment:
+	case tok_menuname:
+	  printf("%s\n", cfg->label);
+	  break;
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	  printf("%s %s\n", cfg->label, cfg->optionname);
+	  break;
+	case tok_if:
+	  dump_if(cfg->cond);
+	  break;
+	case tok_nop:
+	case tok_endmenu:
+	  break;
+	default:
+	  printf("\n");
+	}
+    }
+#endif
+
+  return 0;
+
+}
Index: IOIPSL/tags/v2_1_9/tools/tkparse.h
===================================================================
--- IOIPSL/tags/v2_1_9/tools/tkparse.h	(revision 715)
+++ IOIPSL/tags/v2_1_9/tools/tkparse.h	(revision 715)
@@ -0,0 +1,82 @@
+
+enum token {
+  tok_menuname, 
+  tok_menuoption, 
+  tok_comment, 
+  tok_bool, 
+  tok_tristate, 
+  tok_dep_tristate,
+  tok_nop,
+  tok_if, 
+  tok_else, 
+  tok_fi, 
+  tok_int,
+  tok_hex,
+  tok_make,
+  tok_define,
+  tok_choose,
+  tok_choice,
+  tok_endmenu,
+  tok_unknown
+};
+
+enum operator {
+  op_eq,
+  op_neq,
+  op_and,
+  op_and1,
+  op_or,
+  op_bang,
+  op_lparen,
+  op_rparen,
+  op_variable,
+  op_kvariable,
+  op_shellcmd,
+  op_constant,
+  op_nuked
+};
+
+union var
+{
+  char * str;
+  struct kconfig * cfg;
+};
+
+struct condition
+{
+  struct condition * next;
+  enum operator op;
+  union var variable;
+};
+
+#define GLOBAL_WRITTEN  1
+#define CFG_DUP 	2
+#define UNSAFE		4
+
+struct kconfig
+{
+  struct kconfig 	* next;
+  int 			  flags;
+  enum 			  token tok;
+  char   		  menu_number;
+  char   		  menu_line;
+  char   		  submenu_start;
+  char   		  submenu_end;
+  char 			* optionname;
+  char 			* label;
+  char 			* value;
+  int   		  choice_value;
+  struct kconfig        * choice_label;
+  union var 		  depend;
+  struct condition 	* cond;
+};
+
+extern struct kconfig * config;
+extern struct kconfig * clast;
+extern struct kconfig * koption;
+
+/*
+ * Prototypes
+ */
+void fix_conditionals(struct kconfig * scfg);	/* tkcond.c */
+void dump_tk_script(struct kconfig *scfg);	/* tkgen.c  */
