Index: /OBSOLETE/XMLF90/LICENSE
===================================================================
--- /OBSOLETE/XMLF90/LICENSE	(revision 2354)
+++ /OBSOLETE/XMLF90/LICENSE	(revision 2354)
@@ -0,0 +1,35 @@
+Copyright (c) 2003, 2004, Alberto Garcia (SAX, XPATH, WXML, Overall design)
+(c) 2003, 2004, Jon Wakelin, Alberto Garcia (DOM subsystem)
+(c) 2003, 2004, Jon Wakelin (CML writing subsystem)
+STRINGS module contributed by Mart Reentmeester. (See strings/m_strings.f90)
+
+All rights reserved.
+
+* Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+        
+* Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+        
+* Redistributions in binary form must reproduce the above copyright
+notice, this list of conditions and the following disclaimer in the
+documentation and/or other materials provided with the distribution.
+        
+* Neither the name of the copyright holder nor the names of its
+contributors may be used to endorse or promote products derived from
+this software without specific prior written permission.
+
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
Index: /OBSOLETE/XMLF90/arch/arch-IA64_PLATINE.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-IA64_PLATINE.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-IA64_PLATINE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINKER              mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             
+%BASE_FFLAGS         -i4 -r8 -automatic -align all -I/opt/mpi/current/include
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -i4 -r8 -automatic
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLF90/arch/arch-IA64_PLATINE.path
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-IA64_PLATINE.path	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-IA64_PLATINE.path	(revision 2354)
@@ -0,0 +1,1 @@
+
Index: /OBSOLETE/XMLF90/arch/arch-PW6_VARGAS.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-PW6_VARGAS.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-PW6_VARGAS.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            xlf_r
+%LINKER              xlf_r
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             
+%BASE_FFLAGS         
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O2 -qfullpath -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap
+%DEBUG_FFLAGS        -g -qfullpath -qnooptimize -qinitauto=7FBFFFFF  -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap 
+%MPI_FFLAGS
+%OMP_FFLAGS          
+%BASE_LD             
+%MPI_LD
+%OMP_LD              
Index: /OBSOLETE/XMLF90/arch/arch-SX8_BRODIE.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-SX8_BRODIE.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-SX8_BRODIE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            sxmpif90
+%LINKER              sxmpif90
+%AR                  sxar
+%MAKE                make
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             NC_DOUBLE
+%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
+%MPI_FFLAGS
+%OMP_FFLAGS          -P openmp 
+%BASE_LD             
+%MPI_LD
+%OMP_LD              -P openmp
Index: /OBSOLETE/XMLF90/arch/arch-SX8_MERCURE.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-SX8_MERCURE.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-SX8_MERCURE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            sxmpif90
+%LINKER              sxmpif90
+%AR                  sxar
+%MAKE                make
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             NC_DOUBLE
+%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
+%MPI_FFLAGS
+%OMP_FFLAGS          -P openmp 
+%BASE_LD             -size_t64
+%MPI_LD
+%OMP_LD              -P openmp
Index: /OBSOLETE/XMLF90/arch/arch-SX9_MERCURE.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-SX9_MERCURE.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-SX9_MERCURE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            sxmpif90
+%LINKER              sxmpif90
+%AR                  sxar
+%MAKE                make
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             NC_DOUBLE
+%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
+%MPI_FFLAGS
+%OMP_FFLAGS          -P openmp 
+%BASE_LD             -size_t64
+%MPI_LD
+%OMP_LD              -P openmp
Index: /OBSOLETE/XMLF90/arch/arch-X64_ADA.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-X64_ADA.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-X64_ADA.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpiifort
+%LINKER              mpiifort
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -shared-intel -mcmodel=large -integer-size 32 -real-size 64 -align all
+%PROD_FFLAGS         -O3 -ip
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -shared-intel -mcmodel=large -integer-size 32 -real-size 64 -align all
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLF90/arch/arch-X64_CURIE.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-X64_CURIE.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-X64_CURIE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINKER              mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -i4 -r8 -automatic -align all
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -i4 -r8 -automatic
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLF90/arch/arch-X64_TITANE.fcm
===================================================================
--- /OBSOLETE/XMLF90/arch/arch-X64_TITANE.fcm	(revision 2354)
+++ /OBSOLETE/XMLF90/arch/arch-X64_TITANE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINKER              mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             
+%BASE_FFLAGS         -i4 -r8 -automatic -align all
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -i4 -r8 -automatic
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLF90/bld.cfg
===================================================================
--- /OBSOLETE/XMLF90/bld.cfg	(revision 2354)
+++ /OBSOLETE/XMLF90/bld.cfg	(revision 2354)
@@ -0,0 +1,35 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc arch.fcm
+inc config.fcm
+
+dir::root   $PWD
+
+search_src           1
+bld::lib            xmlf90
+bld::target libxmlf90.a
+
+bld::tool::fc        %COMPILER
+bld::tool::ld        %LINKER
+bld::tool::ar        %AR
+bld::tool::make      %MAKE
+bld::tool::fflags    %FFLAGS
+bld::tool::ldflags   %BASE_LD
+
+# Pre-process code before analysing dependencies
+bld::pp              1
+
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+# Allow ".inc" as an extension for CPP include files
+bld::outfile_ext::mod .mod
+bld::tool::SHELL   /bin/bash
Index: /OBSOLETE/XMLF90/configure
===================================================================
--- /OBSOLETE/XMLF90/configure	(revision 2354)
+++ /OBSOLETE/XMLF90/configure	(revision 2354)
@@ -0,0 +1,106 @@
+#!/bin/csh
+set verbose echo
+set has_arch_opt           = FALSE 
+set has_compile_opt        = FALSE
+set default_compile_flags = "%PROD_FFLAGS"
+
+top:
+if ($#argv > 0) then
+    switch ($1)
+
+    case -h
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+configure_ioserver [Options] 
+
+bla, bla, bla
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+                   
+    case -a
+    case -arch
+        set has_arch_opt = TRUE
+        set arch="$2" ; shift ; shift ; goto top
+
+    case -prod
+        set has_compile_opt = TRUE
+        set compile_flags="%PROD_FFLAGS"
+        shift ; goto top
+
+    case -dev
+        set has_compile_opt = TRUE
+        set compile_flags="%DEV_FFLAGS"
+        shift ; goto top
+
+    case -debug
+        set has_compile_opt = TRUE
+        set compile_flags="%DEBUG_FFLAGS"
+        shift ; goto top
+
+    default
+        echo "unknown option "$1" , exiting..."
+        exit 
+   endsw
+endif
+
+
+#define architecture files
+if ( $has_arch_opt == TRUE) then
+  if ( -e arch/arch-${arch}.fcm ) then
+    rm -f arch.fcm
+    ln -s arch/arch-${arch}.fcm arch.fcm
+  else
+    echo "architecture file : << arch/arch-${arch}.fcm >> is missing, exiting...."
+    exit
+  endif
+  
+  if ( -e arch/arch-${arch}.path ) then
+    rm -f arch.path
+    ln -s arch/arch-${arch}.path arch.path
+  else
+    echo "architecture file : << arch/arch-${arch}.path >> is missing, exiting...."
+    exit
+  endif
+else
+  echo "Warning : architecture not specified, taking default file <<arch.fcm>> and <<arch.path>>" 
+  if ( ! -e arch.fcm ) then
+    echo "architecture file : << arch.fcm >> is missing, exiting...."
+    exit
+  endif
+
+  if ( ! -e arch.fcm ) then
+    echo "architecture file : << arch.path >> is missing, exiting...."
+    exit
+  endif
+endif
+  
+# set compiler flags
+set FFLAGS="%BASE_FFLAGS"
+set LD_FFLAGS="%BASE_LD"
+set CPP_KEY="%FPP_DEF"
+
+# set compiler flags for optimisation
+if ( $has_compile_opt == FALSE ) then
+  set compile_flags=$default_compile_flags
+endif
+set FFLAGS=${FFLAGS}" "$compile_flags
+
+
+source ./arch.path
+
+# build config file
+set config_fcm="config.fcm"
+rm -f $config_fcm
+
+echo "%FFLAGS        $FFLAGS"                           >  $config_fcm 
+echo "%CPP_KEY       $CPP_KEY"                          >> $config_fcm
+echo "%LD_FFLAGS     $LD_FFLAGS"                        >> $config_fcm
Index: /OBSOLETE/XMLF90/src/cml/flib_cml.f90
===================================================================
--- /OBSOLETE/XMLF90/src/cml/flib_cml.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/cml/flib_cml.f90	(revision 2354)
@@ -0,0 +1,7 @@
+module flib_cml
+  use m_stmw
+  use m_cmlw
+ 
+  public
+
+end module flib_cml
Index: /OBSOLETE/XMLF90/src/cml/m_cmlw.f90
===================================================================
--- /OBSOLETE/XMLF90/src/cml/m_cmlw.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/cml/m_cmlw.f90	(revision 2354)
@@ -0,0 +1,1846 @@
+module m_cmlw
+
+  use flib_wxml
+  use m_stmw
+
+  private
+
+  integer, private, parameter ::  sp = selected_real_kind(6,30)
+  integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+
+! CMLUnits
+  character(len=40), parameter :: U_ANGSTR = 'units:angstrom'
+  character(len=40), parameter :: U_PMETER = 'units:pm'
+  character(len=40), parameter :: U_DEGREE = 'units:degree'
+  character(len=40), parameter :: U_RADIAN = 'units:radian'
+  character(len=40), parameter :: U_INVCM  = 'units:cm-1'
+  character(len=40), parameter :: U_KCALMO = 'units:kcal-mole'
+  character(len=40), parameter :: U_EVOLT  = 'units:ev'
+  character(len=40), parameter :: U_SECOND = 'units:second'
+  character(len=40), parameter :: U_VOLT   = 'units:volt'
+
+! CMLCore
+  PUBLIC :: cmlAddCoordinates
+  PUBLIC :: cmlAddCrystal
+  PUBLIC :: cmlAddAngle
+  PUBLIC :: cmlAddLength
+  PUBLIC :: cmlAddEigenvalue
+  PUBLIC :: cmlAddProperty
+  PUBLIC :: cmlAddPropertyList
+  PUBLIC :: cmlAddMolecule
+  PUBLIC :: cmlAddMetadata
+
+! CMLComp
+  PUBLIC :: cmlAddLattice
+  PUBLIC :: cmlAddLatticeVector
+  PUBLIC :: cmlAddParameter
+
+! CMLCore
+  INTERFACE cmlAddCoordinates
+     MODULE PROCEDURE cmlAddCoordinatesSP, cmlAddCoordinatesDP
+  END INTERFACE
+
+  INTERFACE cmlAddCrystal
+     MODULE PROCEDURE cmlAddCrystalSP, cmlAddCrystalDP
+  END INTERFACE
+
+  INTERFACE cmlAddAngle
+     MODULE PROCEDURE cmlAddAngleSP, cmlAddAngleDP
+  END INTERFACE
+
+  INTERFACE cmlAddLength
+     MODULE PROCEDURE cmlAddLengthSP, cmlAddLengthDP
+  END INTERFACE
+
+  INTERFACE cmlAddEigenvalue
+     MODULE PROCEDURE cmlAddEigenvalueSP, cmlAddEigenvalueDP
+  END INTERFACE
+
+  INTERFACE cmlAddMolecule
+     MODULE PROCEDURE cmlAddMoleculeSP, cmlAddMoleculeDP, cmlAddMolecule3SP, &
+                      cmlAddMolecule3DP
+  END INTERFACE
+
+! CMLComa
+  INTERFACE cmlAddLattice
+     MODULE PROCEDURE cmlAddLatticeSP, cmlAddLatticeDP
+  END INTERFACE
+
+  INTERFACE cmlAddLatticeVector
+     MODULE PROCEDURE cmlAddLatticeVectorSP, cmlAddLatticeVectorDP
+  END INTERFACE
+
+  INTERFACE cmlAddProperty
+     MODULE PROCEDURE &
+          cmlAddPropScalarDP, cmlAddPropScalarSP, cmlAddPropScalarI, & 
+          cmlAddPropMatrixDP, cmlAddPropMatrixSP, cmlAddPropMatrixI, &
+          cmlAddPropArrayDP,  cmlAddPropArraySP,  cmlAddPropArrayI
+  END INTERFACE
+
+  INTERFACE cmlAddParameter
+     MODULE PROCEDURE &
+        cmlAddParameterCH, cmlAddParameterI, &
+        cmlAddParameterSP, cmlAddParameterDP, &
+        cmlAddParameterLG
+  END INTERFACE
+
+
+CONTAINS
+
+  ! =================================================
+  ! convenience CML routines
+  ! =================================================
+  
+  ! -------------------------------------------------
+  ! writes a propertyList start Tag to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropertyList(xf, id, title, conv, dictref, ref, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: role
+    
+    call xml_NewElement(xf, 'propertyList')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    
+  END SUBROUTINE cmlAddPropertyList
+  
+  
+  ! -------------------------------------------------
+  ! 1. writes a DP property to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropScalarDP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv))    call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref))    call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+
+  END SUBROUTINE cmlAddPropScalarDP
+
+  ! -------------------------------------------------
+  ! 2. writes a Scalar SP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropScalarSP(xf, property, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in) :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropScalarSP
+  
+  ! -------------------------------------------------
+  ! 3. writes a Scalar integer property to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddPropScalarI(xf, property, id, title, conv, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in) :: property
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddScalar(xf=xf, value=property, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropScalarI
+
+  ! -------------------------------------------------
+  ! 4. writes an Float matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixDP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)      :: nrows
+    integer, intent(in)      :: ncols
+    integer, intent(in)      :: dim
+    real(kind=dp), intent(in) :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixDP
+
+  ! -------------------------------------------------
+  ! 5. writes an SP Float matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixSP(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)      :: nrows
+    integer, intent(in)      :: ncols
+    integer, intent(in)      :: dim
+    real(kind=sp), intent(in) :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf,matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixSP
+
+
+  ! -------------------------------------------------
+  ! 6. writes an Integer matrix property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropMatrixI(xf, property, nrows, ncols, dim, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+
+    integer, intent(in)                    :: nrows
+    integer, intent(in)                    :: ncols
+    integer, intent(in), optional          :: dim
+    integer, intent(in)                    :: property(nrows,ncols)
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(conv)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddMatrix(xf=xf, matrix=property, dim=dim, ncols=ncols, nrows=nrows, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropMatrixI
+
+
+  ! -------------------------------------------------
+  ! 7. writes an Array DP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArrayDP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArrayDP
+
+  ! -------------------------------------------------
+  ! 8. writes an Array SP property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArraySP(xf, property, nvalue, id, title, conv, dictref, ref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: fmt
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf=xf, array=property, nvalue=nvalue, units=units, fmt=fmt)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArraySP
+
+  ! -------------------------------------------------
+  ! 9. writes an Array integer property to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddPropArrayI(xf, property, nvalue, id, title, conv, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: property(*)
+    integer, intent(in)                    :: nvalue
+    character(len=*), intent(in), optional :: id
+    character(len=*), intent(in), optional :: title
+    character(len=*), intent(in), optional :: dictref
+    character(len=*), intent(in), optional :: conv
+    character(len=*), intent(in), optional :: ref
+    character(len=*), intent(in), optional :: units
+
+    call xml_NewElement(xf, 'property')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    call stmAddArray(xf, array=property, nvalue=nvalue, units=units)
+    call xml_EndElement(xf, 'property')
+  END SUBROUTINE cmlAddPropArrayI
+
+  !------------------------------------------------------------
+  ! END OF PROPERTIES 
+  !------------------------------------------------------------
+
+
+  ! -------------------------------------------------
+  ! 1. writes complete DP molecule to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddMoleculeDP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms             ! number of atoms
+    real(kind=dp), intent(in)               :: coords(3, natoms)  ! atomic coordinates
+    character(len=*), intent(in)           :: elements(natoms)   ! chemical element types
+    character(len=*), intent(in), optional :: id                 ! id
+    character(len=*), intent(in), optional :: title              ! the title
+    character(len=*), intent(in), optional :: dictref            ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt                ! format for coords
+    character(len=*), intent(in), optional :: style              ! type of coordinates 
+
+    ! 'x3' for Cartesians, 
+    ! 'xFrac' for fractionals
+    ! default => cartesians
+
+    ! Internal Variables
+    character(len=6) :: id1, id0
+    character(len=10):: formt, stylei
+    integer          :: i
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf, 'molecule', id, title, dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39DP(xf, coords(1, i), coords (2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9DP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+  END SUBROUTINE cmlAddMoleculeDP
+
+  
+  ! -------------------------------------------------
+  ! 2. writes complete SP molecule to xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMoleculeSP(xf, natoms, elements, coords, style, id, title, dictref, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms          ! number of atoms
+    character(len=*), intent(in)           :: elements(*)     ! chemical element types
+    real(kind=sp), intent(in)               :: coords(3, *)    ! atomic coordinates
+    character(len=*), intent(in), optional :: id              ! id
+    character(len=*), intent(in), optional :: title           ! the title
+    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt             ! format for coords
+    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    ! Flush on entry and exit
+    character(len=6) :: id1, id0
+    integer          :: i
+    character(len=10):: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf, 'molecule', id, title, dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9SP(xf, coords(1, i), coords(2, i), coords(3, i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+    
+  END SUBROUTINE cmlAddMoleculeSP
+  
+  
+  ! -------------------------------------------------
+  ! 1. writes complete DP molecule to xml channel (No. 2)
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMolecule3DP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: natoms          ! number of atoms
+    real(kind=dp), intent(in)               :: x(*)
+    real(kind=dp), intent(in)               :: y(*)
+    real(kind=dp), intent(in)               :: z(*)
+    character(len=*), intent(in)           :: elements(*)     ! chemical element types
+    character(len=*), intent(in), optional :: id              ! id
+    character(len=*), intent(in), optional :: title           ! the title
+    character(len=*), intent(in), optional :: dictref         ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt             ! format for coords
+    character(len=*), intent(in), optional :: style           ! type of coordinates ('x3'for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    character(len=6)  :: id1, id0
+    integer           :: i, l
+    character(len=10) :: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = trim(style)
+    else
+       stylei = 'x3'
+    endif
+
+    call stmAddStartTag(xf=xf, name='molecule', id=id, title=title, dictref=dictref)
+    call xml_NewElement(xf, 'atomArray')
+
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (trim(stylei) .eq. 'x3') then
+          call CMLATX39DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xFrac') then
+          call CMLATXF9DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xyz3') then
+          call CMLATXYZ39DP(xf, x(i), y(i), z(i), formt)
+       elseif (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9DP(xf, x(i), y(i), z(i), formt)
+       endif
+       call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+    
+  END SUBROUTINE cmlAddMolecule3DP
+  
+  
+  ! -------------------------------------------------
+  ! 2. writes complete SP molecule to xml channel (No. 2)
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddMolecule3SP(xf, natoms, elements, x, y, z, style, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    ! 10 Arguments
+    integer, intent(in)                    :: natoms          ! number of atoms
+    real(kind=sp), intent(in)               :: x(*)
+    real(kind=sp), intent(in)               :: y(*)
+    real(kind=sp), intent(in)               :: z(*)
+    character(len=*), intent(in)           :: elements(*)      ! chemical element types
+    character(len=*), intent(in), optional :: id               ! id
+    character(len=*), intent(in), optional :: title            ! the title
+    character(len=*), intent(in), optional :: dictref          ! the dictionary reference
+    character(len=*), intent(in), optional :: fmt              ! format for coords
+    character(len=*), intent(in), optional :: style            ! type of coordinates ('x3' for Cartesians, 'xFrac' 
+    ! for fractionals; ' ' = default => cartesians)
+    ! Internal variables
+    character(len=6)  :: id1, id0
+    integer           :: i, l
+    character(len=10) :: formt, stylei
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    call xml_NewElement(xf, 'molecule')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'title', title)
+    call xml_AddAttribute(xf, 'dictref', dictref)
+    call xml_NewElement(xf, 'atomArray')
+    do i = 1, natoms
+       write(id0, '(i4)') i
+       id0 = adjustl(id0)
+       id1 = 'a'
+       id1(2:) = id0
+       call cmlAddAtom(xf=xf, elem=elements(i), id=id1)
+       if (stylei .eq. 'x3') then
+          call CMLATX39SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xFrac') then
+          call CMLATXF9SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xyz3') then
+          call CMLATXYZ39SP(xf, x(i), y(i), z(i), formt)
+       else if (stylei .eq. 'xyzFrac') then
+          call CMLATXYZFRACT9SP(xf, x(i), y(i), z(i), formt)
+       endif
+           call xml_EndElement(xf, 'atom')
+    enddo
+
+    call xml_EndElement(xf, 'atomArray')
+    call xml_EndElement(xf, 'molecule')
+
+  END SUBROUTINE cmlAddMolecule3SP
+  
+  ! -------------------------------------------------
+  ! writes an <atom> start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddAtom(xf, elem, id, charge, hCount, occupancy, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in), optional           :: charge     ! formalCharge
+    integer, intent(in), optional           :: hCount     ! hydrogenCount
+    real(kind=sp), intent(in), optional      :: occupancy  ! hydrogenCount
+    character(len=*), intent(in), optional  :: elem       ! chemical element name
+    character(len=*), intent(in), optional  :: id         ! atom id
+    character(len=*), intent(in), optional  :: fmt        ! format
+
+    ! internal Variable
+    character(len=10):: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'atom')
+    if (present(elem))      call xml_AddAttribute(xf, 'elementType', elem)
+    if (present(id))        call xml_AddAttribute(xf, 'id', id)
+    if (present(charge))    call xml_AddAttribute(xf, 'formalCharge', str(charge))
+    if (present(hCount))    call xml_AddAttribute(xf, 'hydrogenCount', str(hCount))
+    if (present(occupancy)) call xml_AddAttribute(xf, 'occupancy', str(occupancy,formt))
+
+  END SUBROUTINE cmlAddAtom
+  
+  
+  ! -------------------------------------------------
+  ! 1. append SP coordinates to atom tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddCoordinatesSP(xf, x, y, z, style, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: x, y
+    real(kind=sp), intent(in), optional     :: z
+    character(len=*), intent(in), optional :: style
+    character(len=*), intent(in), optional :: fmt
+
+    ! Internal variable
+    character(len=10):: formt
+    character(len=10):: stylei
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+
+    if (present(z) .and. stylei .eq. 'x3') then
+       call CMLATX39SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xFrac') then
+       call CMLATXF9SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyz3') then
+       call CMLATXYZ39SP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyzFrac') then
+       call CMLATXYZFRACT9SP(xf, x, y, z, formt)
+    elseif (.not. present(z) .and. stylei .eq. 'xy2') then
+       call CMLATXY9SP(xf, x, y, formt)           
+    endif
+
+  END SUBROUTINE cmlAddCoordinatesSP
+
+  ! -------------------------------------------------
+  ! 2. append DP coordinates to atom tag
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCoordinatesDP(xf, x, y, z, style, fmt)
+    implicit none
+    type(xmlf_t) :: xf 
+    real(kind=dp), intent(in)               :: x, y
+    real(kind=dp), intent(in), optional     :: z
+    character(len=*), intent(in), optional :: style
+    character(len=*), intent(in), optional :: fmt
+    
+    ! Internal variable
+    character(len=10):: formt
+    character(len=10):: stylei
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(style)) then
+       stylei = style
+    else
+       stylei = 'x3'
+    endif
+    
+    if (present(z) .and. stylei .eq. 'x3') then
+       call CMLATX39DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xFrac') then
+       call CMLATXF9DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyz3') then
+       call CMLATXYZ39DP(xf, x, y, z, formt)
+    else if (present(z) .and. stylei .eq. 'xyzFrac') then
+       call CMLATXYZFRACT9DP(xf, x, y, z, formt)
+    else if (.not. present(z) .and. stylei .eq. 'xy2') then
+       call CMLATXY9DP(xf, x, y, formt)           
+    endif
+    
+  END SUBROUTINE cmlAddCoordinatesDP
+
+  
+  ! -------------------------------------------------
+  ! 1. writes a DP <length> element to output channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLengthDP(xf, length, id, atomRef1, atomRef2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: length     ! length
+    character(len=*), intent(in) :: id         ! length id
+    character(len=*), intent(in) :: atomRef1   ! ref to first atom
+    character(len=*), intent(in) :: atomRef2   ! ref to second atom
+    character(len=*), intent(in) :: fmt        ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLLEN9DP(xf, id, atomRef1, atomRef2, length, formt)
+  END SUBROUTINE cmlAddLengthDP
+
+  ! -------------------------------------------------
+  ! 2. writes a SP <length> element to output channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLengthSP(xf, length, id, atomRef1, atomRef2, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: length     ! the length
+    character(len=*), intent(in) :: id         ! length id
+    character(len=*), intent(in) :: atomRef1   ! ref to first atom
+    character(len=*), intent(in) :: atomRef2   ! ref to second atom
+    character(len=*), intent(in) :: fmt        ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLLEN9SP(xf, id, atomRef1, atomRef2, length, formt)
+  END SUBROUTINE cmlAddLengthSP
+
+
+  ! -------------------------------------------------
+  ! 1. writes an DP <angle> element to output channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddAngleDP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: angle        ! the angle
+    character(len=*), intent(in) :: id           ! angle id
+    character(len=*), intent(in) :: atomRef1     ! ref to first atom
+    character(len=*), intent(in) :: atomRef2     ! ref to second atom
+    character(len=*), intent(in) :: atomRef3     ! ref to third atom
+    character(len=*), intent(in) :: fmt          ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+  END SUBROUTINE cmlAddAngleDP
+
+  ! -------------------------------------------------
+  ! 2. writes an SP <angle> element to output channel
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddAngleSP(xf, angle, id, atomRef1, atomRef2, atomRef3, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: angle        ! the angle
+    character(len=*), intent(in) :: id           ! angle id
+    character(len=*), intent(in) :: atomRef1     ! ref to first atom
+    character(len=*), intent(in) :: atomRef2     ! ref to second atom
+    character(len=*), intent(in) :: atomRef3     ! ref to third atom
+    character(len=*), intent(in) :: fmt          ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, formt)
+  END SUBROUTINE cmlAddAngleSP
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes a DP <torsion> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddTorsionDP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: torsion         ! the torsion
+    character(len=*), intent(in) :: id              ! torsion id
+    character(len=*), intent(in) :: atomRef1        ! ref to first atom
+    character(len=*), intent(in) :: atomRef2        ! ref to second atom
+    character(len=*), intent(in) :: atomRef3        ! ref to third atom
+    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
+    character(len=*), intent(in) :: fmt             ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+  END SUBROUTINE cmlAddTorsionDP
+  
+  ! -------------------------------------------------
+  ! 2. creates and writes a SP <torsion> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddTorsionSP(xf, torsion, id, atomRef1, atomRef2, atomRef3, atomRef4, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: torsion         ! the torsion
+    character(len=*), intent(in) :: id              ! torsion id
+    character(len=*), intent(in) :: atomRef1        ! ref to first atom
+    character(len=*), intent(in) :: atomRef2        ! ref to second atom
+    character(len=*), intent(in) :: atomRef3        ! ref to third atom
+    character(len=*), intent(in) :: atomRef4        ! ref to fourth atom
+    character(len=*), intent(in) :: fmt             ! format
+
+    optional         :: fmt
+    character(len=10):: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, formt)
+  END SUBROUTINE cmlAddTorsionSP
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes an SP Lattice element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeSP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: cell(3,3)
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: conv         ! format
+    character(len=*), intent(in), optional :: lattType     ! 
+    character(len=*), intent(in), optional :: spaceType    !
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Internal Variables
+    integer           :: i
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'lattice')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+    do i = 1,3
+       call xml_NewElement(xf, 'latticeVector')
+       if (present(units)) call xml_AddAttribute(xf, 'units', units)
+       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+       call xml_AddPcdata(xf, str(cell(1,i), formt))
+       call xml_AddPcdata(xf, str(cell(2,i), formt))
+       call xml_AddPcdata(xf, str(cell(3,i), formt))
+    call xml_EndElement(xf, 'latticeVector')
+    enddo
+    call xml_EndElement(xf, 'lattice')
+
+  END SUBROUTINE cmlAddLatticeSP
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes DP Lattice element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeDP(xf, cell, units, title, id, dictref, conv, lattType, spaceType, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: cell(3,3)
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: conv         ! format
+    character(len=*), intent(in), optional :: lattType     ! 
+    character(len=*), intent(in), optional :: spaceType    !
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Internal Variables
+    integer           :: i
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'lattice')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(lattType)) call xml_AddAttribute(xf, 'latticeType', lattType)
+    if (present(spaceType)) call xml_AddAttribute(xf, 'spaceType', spaceType)
+
+    do i = 1,3
+       call xml_NewElement(xf, 'latticeVector')
+       if (present(units)) call xml_AddAttribute(xf, 'units', units)
+       call xml_AddAttribute(xf, 'dictRef', 'cml:latticeVector')
+       call xml_AddPcdata(xf, str(cell(1,i), formt))
+       call xml_AddPcdata(xf, str(cell(2,i), formt))
+       call xml_AddPcdata(xf, str(cell(3,i), formt))
+       call xml_EndElement(xf, 'latticeVector')
+    enddo
+    
+    call xml_EndElement(xf, 'lattice')
+
+  END SUBROUTINE cmlAddLatticeDP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP Lattice Vector element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddLatticeVectorDP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in) :: vector(3)
+    character(len=*), intent(in), optional :: title        
+    character(len=*), intent(in), optional :: id           
+    character(len=*), intent(in), optional :: dictref     
+    character(len=*), intent(in), optional :: conv        
+    character(len=*), intent(in), optional :: units       
+    character(len=*), intent(in), optional :: periodic    
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Deal with optional things
+    ! that have defaults
+    character(len=10) :: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'latticeVector')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(units)) call xml_AddAttribute(xf, 'units', units)
+    if (present(periodic)) call xml_AddAttribute(xf, 'periodic', periodic)
+    call xml_AddPcdata(xf, str(vector(1), formt))
+    call xml_AddPcdata(xf, str(vector(2), formt))
+    call xml_AddPcdata(xf, str(vector(3), formt))
+    call xml_EndElement(xf, 'latticeVector')
+
+  END SUBROUTINE cmlAddLatticeVectorDP
+
+
+  ! -------------------------------------------------
+  ! 2. creates a SP Lattice Vector element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddLatticeVectorSP(xf, vector, title, id, dictref, conv, units, periodic, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in) :: vector(3)
+    character(len=*), intent(in), optional :: title        
+    character(len=*), intent(in), optional :: id           
+    character(len=*), intent(in), optional :: dictref     
+    character(len=*), intent(in), optional :: conv        
+    character(len=*), intent(in), optional :: units       ! should this be optional
+    character(len=*), intent(in), optional :: periodic    
+    character(len=*), intent(in), optional :: fmt         
+
+    ! Deal with optional things
+    ! that have defaults
+    character(len=10) :: formt
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'   
+    endif
+
+    call xml_NewElement(xf, 'latticeVector')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(units)) call xml_AddAttribute(xf, 'units', units)
+    if (present(units)) call xml_AddAttribute(xf, 'periodic', periodic)
+    call xml_AddPcdata(xf, str(vector(1), formt))
+    call xml_AddPcdata(xf, str(vector(2), formt))
+    call xml_AddPcdata(xf, str(vector(3), formt))
+    call xml_EndElement(xf, 'latticeVector')
+
+  END SUBROUTINE cmlAddLatticeVectorSP
+
+  ! -------------------------------------------------
+  ! 1. creates and writes a DP <cell> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCrystalDP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: a, b, c      ! cell parameters
+    real(kind=dp), intent(in)               :: alpha        ! alpha cell parameter
+    real(kind=dp), intent(in)               :: beta         ! beta cell parameter
+    real(kind=dp), intent(in)               :: gamma        ! gamma cell parameter
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: lenunits     ! units for length (default = angstrom)
+    character(len=*), intent(in), optional :: angunits     ! units for angles (default = degree)
+    character(len=*), intent(in), optional :: fmt          ! format
+
+    ! Flush on entry and exit
+    character(len=30) ::  lunits, aunits
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(lenunits)) then
+       lunits = lenunits
+    else
+       lunits = 'units:angstrom'
+    endif
+    if (present(angunits)) then
+       aunits = angunits
+    else
+       aunits = 'units:degree'
+    endif
+
+    call stmAddStartTag(xf=xf, name='crystal', id=id, title=title, dictref=dictref)
+    call stmAddScalar(xf=xf, value=a, title='a', dictref='cml:a', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=b, title='b', dictref='cml:b', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=c, title='c', dictref='cml:c', units=lunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=alpha, title='alpha', dictref='cml:alpha', units=aunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=beta,  title='beta',  dictref='cml:beta',  units=aunits, fmt=formt)
+    call stmAddScalar(xf=xf, value=gamma, title='gamma', dictref='cml:gamma', units=aunits, fmt=formt)
+    call xml_EndElement(xf, 'crystal')
+
+  END SUBROUTINE cmlAddCrystalDP
+
+  ! -------------------------------------------------
+  ! 2. creates and writes a SP <cell> element
+  ! -------------------------------------------------
+
+  SUBROUTINE cmlAddCrystalSP(xf, a, b, c, alpha, beta, gamma, id, title, dictref, lenunits, angunits, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: a, b, c      ! cell parameters
+    real(kind=sp), intent(in)     :: alpha        ! alpha cell parameter
+    real(kind=sp), intent(in)     :: beta         ! beta cell parameter
+    real(kind=sp), intent(in)     :: gamma        ! gamma cell parameter
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! title
+    character(len=*), intent(in), optional :: dictref      ! dictref
+    character(len=*), intent(in), optional :: lenunits     ! units for length (' ' = angstrom)
+    character(len=*), intent(in), optional :: angunits     ! units for angles (' ' = degree)
+    character(len=*), intent(in), optional :: fmt          ! format
+
+    ! Flush on entry and exit
+    character(len=30) :: lunits, aunits
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+    if (present(lenunits)) then
+       lunits = lenunits
+    else
+       lunits = U_ANGSTR
+    endif
+    if (present(angunits)) then
+       aunits = angunits
+    else
+       aunits = U_DEGREE
+    endif
+
+    call stmAddStartTag(xf, 'crystal', id, title, dictref)
+    call stmAddScalar(xf, a, ' ', 'a', 'cml:a', lunits, formt)
+    call stmAddScalar(xf, b, ' ', 'b', 'cml:b', lunits, formt)
+    call stmAddScalar(xf, c, ' ', 'c', 'cml:c', lunits, formt)
+    call stmAddScalar(xf, alpha, ' ', 'alpha', 'cml:alpha', aunits, formt)
+    call stmAddScalar(xf, beta, ' ', 'beta', 'cml:beta', aunits, formt)
+    call stmAddScalar(xf, gamma, ' ', 'gamma', 'cml:gamma', aunits, formt)
+    call xml_EndElement(xf, 'crystal')
+
+  END SUBROUTINE cmlAddCrystalSP
+  
+  
+  ! -------------------------------------------------
+  ! 1. creates and writes an DP <eigen> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddEigenvalueDP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: n              ! number of elements
+    integer, intent(in)          :: dim            ! dimension of matrix
+    real(kind=dp), intent(in)     :: eigvec(dim, *) ! eigenvectors
+    real(kind=dp), intent(in)     :: eigval(*)      ! eigenvalues
+    character(len=*), intent(in), optional :: id             ! id
+    character(len=*), intent(in), optional :: title          ! title
+    character(len=*), intent(in), optional :: dictref        ! dictionary reference
+    character(len=*), intent(in), optional :: fmt            ! format
+    character(len=10):: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'eigen')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+    call xml_EndElement(xf, 'eigen')
+
+  END SUBROUTINE cmlAddEigenvalueDP
+
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes an SP <eigen> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE cmlAddEigenvalueSP(xf, n, dim, eigvec, eigval, id, title, dictref, fmt)
+
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: n              ! number of elements
+    integer, intent(in)          :: dim            ! dimension of matrix
+    real(kind=sp), intent(in)     :: eigvec(dim, *) ! eigenvectors
+    real(kind=sp), intent(in)     :: eigval(*)      ! eigenvalues
+    character(len=*), intent(in), optional :: id             ! id
+    character(len=*), intent(in), optional :: title          ! title
+    character(len=*), intent(in), optional :: dictref        ! dictionary reference
+    character(len=*), intent(in), optional :: fmt            ! format
+    character(len=10):: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'eigen')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    call stmAddArray(xf=xf, nvalue=n, array=eigval, title='eigenvalues', dictref=dictRef, fmt=fmt)
+    call stmAddMatrix(xf=xf, ncols=n, nrows=n, dim=dim, matrix=eigvec, title='eigenvectors', fmt=fmt)
+    call xml_EndElement(xf, 'eigen')
+
+  END SUBROUTINE cmlAddEigenvalueSP
+
+
+  SUBROUTINE cmlAddMetadata(xf, name, content, conv)
+    
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: name
+    character(len=*) :: content
+    character(len=*), optional :: conv
+    
+    call xml_NewElement(xf, 'metadata')
+    call xml_AddAttribute(xf, 'name', name)
+    call xml_AddAttribute(xf, 'content', content)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    call xml_EndElement(xf, 'metadata')
+
+  END SUBROUTINE cmlAddMetadata
+
+
+  ! -------------------------------------------------
+  ! 1. creates and writes an Char <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterCh(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, value)
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', value)
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERCH
+
+
+  ! -------------------------------------------------
+  ! 2. creates and writes an SP <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterSP(xf, value, ref, title, id, conv, &
+       cons, units, name, role, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+    character(len=*), optional :: fmt    
+
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value,formt))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERSP
+
+
+  ! -------------------------------------------------
+  ! 3. creates and writes an DP <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterDP(xf, value, ref, title, id, conv, &
+       cons, units, name, role, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp) :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+    character(len=*), optional :: fmt    
+
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERDP
+
+
+  ! -------------------------------------------------
+  ! 4. creates and writes an Integer <parameter> element
+  ! -------------------------------------------------
+
+
+  SUBROUTINE cmlAddParameterI(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERI
+
+  SUBROUTINE cmlAddParameterLG(xf, value, ref, id, title, conv, &
+       cons, units, name, role)
+
+    implicit none
+    type(xmlf_t) :: xf
+    logical      :: value 
+    character(len=*), optional :: ref 
+    character(len=*), optional :: title
+    character(len=*), optional :: id
+    character(len=*), optional :: conv
+    character(len=*), optional :: cons
+    character(len=*), optional :: units
+    character(len=*), optional :: name
+    character(len=*), optional :: role
+
+    call xml_NewElement(xf, 'parameter')
+    if (present(ref)) call xml_AddAttribute(xf, 'ref', ref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(conv)) call xml_AddAttribute(xf, 'convention', conv)
+    if (present(cons)) call xml_AddAttribute(xf, 'constraint', cons)
+    if (present(name)) call xml_AddAttribute(xf, 'name', name)
+    if (present(role)) call xml_AddAttribute(xf, 'role', role)
+    if (present(units)) then
+       call xml_NewElement(xf, 'scalar')
+       call xml_AddAttribute(xf, 'units', units)
+       call xml_AddPcdata(xf, str(value))
+       call xml_EndElement(xf, 'scalar')
+    else
+       call xml_AddAttribute(xf, 'value', str(value))
+    endif
+    call xml_EndElement(xf, 'parameter')
+
+  END SUBROUTINE CMLADDPARAMETERLG
+
+
+
+! =================================================
+! basic CML routines
+! =================================================
+
+  
+  ! -------------------------------------------------
+  ! 1. adds DP xyz3 to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXYZ39DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZ39DP
+
+
+  ! -------------------------------------------------
+  ! 2. adds SP xyz3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXYZ39SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyz3', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZ39SP
+  
+  ! -------------------------------------------------
+  ! 1. adds DP xyzFrac to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXYZFRACT9DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)      :: x3, y3, z3 ! coordinates
+    character(len=*)  :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(adjustl(y))//' '//trim(adjustl(z)) )
+
+  END SUBROUTINE CMLATXYZFRACT9DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP xyzFrac to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXYZFRACT9SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    character(len=45) :: x, y, z
+
+    write(x,fmt) x3
+    write(y,fmt) y3
+    write(z,fmt) z3
+
+    call xml_AddAttribute(xf, 'xyzFrac', trim(x)//' '//trim(y)//' '//trim(z))
+
+  END SUBROUTINE CMLATXYZFRACT9SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP x3, y3, z3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATX39DP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+  END SUBROUTINE CMLATX39DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP x3, y3, z3 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATX39SP(xf, x3, y3, z3, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)     :: x3, y3, z3 ! coordinates
+    character(len=*), intent(in) :: fmt        ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'x3', str(x3, fmt))
+    call xml_AddAttribute(xf, 'y3', str(y3, fmt))
+    call xml_AddAttribute(xf, 'z3', str(z3, fmt))
+
+  END SUBROUTINE CMLATX39SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP xFract, yFract, zFract to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXF9DP(xf, xFract, yFract, zFract, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)     :: xFract, yFract, zFract ! coordinates
+    character(len=*), intent(in) :: fmt                    ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+  END SUBROUTINE CMLATXF9DP
+  
+  ! -------------------------------------------------
+  ! 2. adds SP xfrac, yFractractrac, zFractrac to start tag
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLATXF9SP(xf, xFract, yFract, zFract, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)     :: xFract, yFract, zFract   ! fractional coordinates
+    character(len=*) :: fmt                      ! format (default '(f8.3)')
+
+    call xml_AddAttribute(xf, 'xFract', str(xFract, fmt))
+    call xml_AddAttribute(xf, 'yFract', str(yFract, fmt))
+    call xml_AddAttribute(xf, 'zFract', str(zFract, fmt))
+
+  END SUBROUTINE CMLATXF9SP
+
+
+  ! -------------------------------------------------
+  ! 1. adds DP x2, y2 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXY9DP(xf, x2, y2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp)     :: x2, y2   ! coordinates
+    character(len=*) :: fmt      ! format (default f8.3)
+
+    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+    call xml_AddPcdata(xf, '>')                   !!! AG****
+
+  END SUBROUTINE CMLATXY9DP
+
+  ! -------------------------------------------------
+  ! 2. adds SP x2, y2 to start tag
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLATXY9SP(xf, x2, y2, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp)     :: x2, y2   ! coordinates
+    character(len=*) :: fmt      ! format (default f8.3)
+
+    call xml_AddAttribute(xf, 'x2', str(x2, fmt))
+    call xml_AddAttribute(xf, 'y2', str(y2, fmt))
+    call xml_AddPcdata(xf, '>')                      !!AG***
+
+  END SUBROUTINE CMLATXY9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <length> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLLEN9DP(xf, id, atomRef1, atomRef2, length, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id           ! length id
+    character(len=*) :: atomRef1     ! ref to first atom
+    character(len=*) :: atomRef2     ! ref to second atom
+    real(kind=dp)     :: length       ! the length
+    character(len=*) :: fmt          ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)
+
+    call xml_NewElement(xf, 'length')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs2', temp)
+    call xml_AddPcdata(xf, str(length, fmt))
+    call xml_EndElement(xf, 'length')
+
+  END SUBROUTINE CMLLEN9DP
+  
+  ! -------------------------------------------------
+  ! 2. creates a SP <length> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLLEN9SP(xf, id, atomRef1, atomRef2, length, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id           ! length id
+    character(len=*) :: atomRef1     ! ref to first atom
+    character(len=*) :: atomRef2     ! ref to second atom
+    real(kind=sp)     :: length       ! the length
+    character(len=*) :: fmt          ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)
+
+    call xml_NewElement(xf, 'length')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs2', temp)
+    call xml_AddPcdata(xf, str(length, fmt))
+    call xml_EndElement(xf, 'length')
+
+  END SUBROUTINE CMLLEN9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <angle> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLANG9DP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! angle id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    real(kind=dp)     :: angle           ! the angle
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+    call xml_NewElement(xf, 'angle')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs3', temp)
+    call xml_AddPcdata(xf, str(angle, fmt))
+    call xml_EndElement(xf, 'angle')
+
+  END SUBROUTINE CMLANG9DP
+
+  ! -------------------------------------------------
+  ! 2. creates a SP <angle> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLANG9SP(xf, id, atomRef1, atomRef2, atomRef3, angle, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! angle id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    real(kind=sp)     :: angle           ! the angle
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)
+
+    call xml_NewElement(xf, 'angle')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs3', temp)
+    call xml_AddPcdata(xf, str(angle, fmt))
+    call xml_EndElement(xf, 'angle')
+
+  END SUBROUTINE CMLANG9SP
+
+
+  ! -------------------------------------------------
+  ! 1. creates a DP <torsion> element
+  ! -------------------------------------------------
+  
+  SUBROUTINE CMLTOR9DP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! torsion id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    character(len=*) :: atomRef4        ! ref to fourth atom
+    real(kind=dp)     :: torsion         ! the torsion
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+    call xml_NewElement(xf, 'torsion')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs4', temp)
+    call xml_AddPcdata(xf, str(torsion, fmt))
+    call xml_EndElement(xf, 'torsion')
+
+  END SUBROUTINE CMLTOR9DP
+
+  ! -------------------------------------------------
+  ! 2. creates a SP <torsion> element
+  ! -------------------------------------------------
+
+  SUBROUTINE CMLTOR9SP(xf, id, atomRef1, atomRef2, atomRef3, atomRef4, torsion, fmt)
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*) :: id              ! torsion id
+    character(len=*) :: atomRef1        ! ref to first atom
+    character(len=*) :: atomRef2        ! ref to second atom
+    character(len=*) :: atomRef3        ! ref to third atom
+    character(len=*) :: atomRef4        ! ref to fourth atom
+    real(kind=sp)     :: torsion         ! the torsion
+    character(len=*) :: fmt             ! format
+    character(len=20) :: temp
+
+    temp = atomRef1//' '//adjustl(atomRef2)//' '//adjustl(atomRef3)//' '//adjustl(atomRef4)
+
+    call xml_NewElement(xf, 'torsion')
+    call xml_AddAttribute(xf, 'id', id)
+    call xml_AddAttribute(xf, 'atomRefs4', temp)
+    call xml_AddPcdata(xf, str(torsion, fmt))
+    call xml_EndElement(xf, 'torsion')
+
+  END SUBROUTINE CMLTOR9SP
+
+end module m_cmlw
Index: /OBSOLETE/XMLF90/src/cml/m_stmw.f90
===================================================================
--- /OBSOLETE/XMLF90/src/cml/m_stmw.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/cml/m_stmw.f90	(revision 2354)
@@ -0,0 +1,875 @@
+module m_stmw
+
+  use flib_wxml
+
+  private
+
+  integer, private, parameter ::  sp = selected_real_kind(6,30)
+  integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+!  TYPE(xmlf_t), save,  :: xf
+
+  PUBLIC :: stmAddScalar
+  PUBLIC :: stmAddArray
+  PUBLIC :: stmAddMatrix
+  PUBLIC :: stmAddTriangle
+  PUBLIC :: stmAddStartTag
+
+  INTERFACE stmAddScalar
+     MODULE PROCEDURE stmAddString, stmAddInteger, stmAddFloatSP, stmAddFloatDP
+  END INTERFACE
+
+  INTERFACE stmAddArray
+     MODULE PROCEDURE stmAddFloatArraySP, stmAddFloatArrayDP, stmAddStringArray, &
+                      stmAddIntegerArray
+  END INTERFACE
+
+  INTERFACE stmAddMatrix
+     MODULE PROCEDURE stmAddFloatMatrixSP, stmAddFloatMatrixDP, stmAddIntegerMatrix
+  END INTERFACE
+
+  INTERFACE stmAddTriangle
+     MODULE PROCEDURE stmAddTriangleSP, stmAddTriangleDP
+  END INTERFACE
+
+ 
+CONTAINS
+  
+  
+  ! =================================================
+  ! STMML convenience routines
+  ! =================================================
+  
+  ! -------------------------------------------------
+  ! create STMML start tag in xml channel
+  ! -------------------------------------------------
+  
+  SUBROUTINE stmAddStartTag(xf, name, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in) :: name                   ! the element name
+    character(len=*), intent(in), optional :: id           ! the element id; if whitespace, is omitted
+    character(len=*), intent(in), optional :: title        ! the title; if whitespace, is omitted
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference; if whitespace, is omitted
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units
+
+!    call XMLCHKN9(name)
+    call xml_NewElement(xf, name)
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+
+  END SUBROUTINE stmAddStartTag
+
+
+  ! -------------------------------------------------
+  ! outputs STMML scalar in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddString(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: value         ! the value to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units
+
+    ! Internal variables
+    character(len=20) :: temp
+
+!    if (XMLCHKS9(value)) then
+    call xml_AddPcdata(xf, ' '//value)
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddString
+
+
+  ! -------------------------------------------------
+  ! outputs STMML integer in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddInteger(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in) :: value                           ! the value to be output
+    character(len=*), intent(in), optional :: id           ! the id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units        ! units (default = none)
+
+
+    ! Flush on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'dictRef', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'title', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddInteger
+
+
+  ! -------------------------------------------------
+  ! 1. create an STMML <scalar> DP float in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatDP(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=dp), intent(in)               :: value        ! the value to be output
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: units        ! units
+    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
+
+    ! Internal Vaiable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f10.4)'
+    endif
+
+
+    ! Flushes on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref))    call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddFloatDP
+
+  ! -------------------------------------------------
+  ! 2. create an STMML <scalar> SP float in xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatSP(xf, value, id, title, dictref, dataType, &
+       convention, errorValue, errorBasis, min, max, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    real(kind=sp), intent(in)               :: value        ! the value to be output
+    character(len=*), intent(in), optional :: id           ! id
+    character(len=*), intent(in), optional :: title        ! the title
+    character(len=*), intent(in), optional :: dictref      ! the dictionary reference
+    character(len=*), intent(in), optional :: units        ! units (' ' = none)
+    character(len=*), intent(in), optional :: dataType  
+    character(len=*), intent(in), optional :: convention
+    character(len=*), intent(in), optional :: errorValue
+    character(len=*), intent(in), optional :: errorBasis
+    character(len=*), intent(in), optional :: min
+    character(len=*), intent(in), optional :: max
+    character(len=*), intent(in), optional :: fmt          ! the format (default 'f10.4')
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f10.4)'
+    endif
+
+    ! Flushes on entry and exit
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))         call xml_AddAttribute(xf, 'id', id)
+    if (present(title))      call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref))    call xml_AddAttribute(xf, 'title', title)
+    if (present(dataType))   call xml_AddAttribute(xf, 'dataType', dataType)
+    if (present(convention)) call xml_AddAttribute(xf, 'convention', convention)
+    if (present(errorValue)) call xml_AddAttribute(xf, 'errorValue', errorValue)
+    if (present(errorBasis)) call xml_AddAttribute(xf, 'errorBasis', errorBasis)
+    if (present(min))        call xml_AddAttribute(xf, 'min', min)
+    if (present(max))        call xml_AddAttribute(xf, 'max', max)
+    if (present(units))      call xml_AddAttribute(xf, 'units', units)
+    call xml_AddPcdata(xf, str(value))
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE stmAddFloatSP
+
+
+  ! -------------------------------------------------
+  ! outputs string array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddStringArray(xf, nvalue, array, id, title, dictref, type, delim, ref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    character(len=*), intent(in)           :: array(*)      ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: type          ! the dataType
+    character(len=*), intent(in), optional :: delim         ! delimiter
+    character(len=*), intent(in), optional :: ref           ! delimiter
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    character(len=1) :: delim1
+    integer          :: i
+
+
+    if (present(delim)) then
+       delim1 = delim
+    else
+       delim1 = ' '
+    endif
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(type))    call xml_AddAttribute(xf, 'type', type)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'delimiter', delim1)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+
+    call xml_AddPcdata(xf, array(1))
+    do i = 2, nvalue
+       if (delim1 .eq. ' ') then
+          call xml_AddPcdata(xf, ' '//array(i))
+       else
+          call xml_AddPcdata(xf, delim1//array(i))
+       endif
+    enddo
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddStringArray
+
+
+  ! -------------------------------------------------
+  ! outputs integer array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddIntegerArray(xf, nvalue, array, id, title, dictref, ref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! the number of values to be output
+    integer, intent(in)                    :: array(*)      ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: ref           ! scienitific units (default ' ')
+
+    ! splits data into lines wherever it overflows the workspace
+    integer          :: i
+
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+
+
+    call xml_AddPcdata(xf, str(array(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(array(i)))
+    enddo
+    call xml_EndElement(xf, 'array')
+    
+  END SUBROUTINE stmAddIntegerArray
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP float array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatArrayDP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    real(kind=dp), intent(in)               :: array(*)       ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: ref           ! 
+    character(len=*), intent(in), optional :: fmt           ! the output format
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9DP(xf, nvalue, array, fmt)
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddFloatArrayDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatArraySP(xf, nvalue, array, id, title, dictref, units, ref, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue        ! number of values to be output
+    real(kind=sp), intent(in)               :: array(*)       ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt           ! the output format
+    character(len=*), intent(in), optional :: ref           ! the output format
+
+    ! Internal Variable
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    if (present(ref))     call xml_AddAttribute(xf, 'ref', ref)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9SP(xf, nvalue, array, fmt)
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE stmAddFloatArraySP
+
+
+  ! -------------------------------------------------
+  ! outputs integer matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddIntegerMatrix(xf, nrows, ncols, dim, matrix, id, title, dictref, units)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nrows         ! the number of rows to be output
+    integer, intent(in)                    :: ncols         ! the number of rows to be output
+    integer, intent(in)                    :: dim           ! the range of the fastest index
+    integer, intent(in)                    :: matrix(nrows,ncols) ! the values to be output
+    character(len=*), intent(in), optional :: id            ! the id
+    character(len=*), intent(in), optional :: title         ! the title
+    character(len=*), intent(in), optional :: dictref       ! the dictionary reference
+    character(len=*), intent(in), optional :: units         ! scienitific units (default ' ')
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit
+    integer ::  i, j
+
+
+
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(dictref))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+
+!
+!   Try addArray...
+!
+    do i = 1, ncols
+       do j = 1, nrows
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddIntegerMatrix
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP float matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatMatrixDP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: ncols                ! the number of cols to be output
+    integer, intent(in)                    :: nrows                ! the number of rows to be output
+    integer, intent(in)                    :: dim                  ! the range of the fastest index
+    real(kind=dp), intent(in)               :: matrix(ncols,nrows)  ! the values to be output
+    character(len=*), intent(in), optional :: id                   ! the id
+    character(len=*), intent(in), optional :: title                ! the title
+    character(len=*), intent(in), optional :: dictref              ! the dictionary reference
+    character(len=*), intent(in), optional :: units                ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt                  ! format
+
+    ! internal variable
+    character(len=10) :: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit      
+    !-------------
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+    !-------------
+    do i = 1, nrows
+       do j = 1, ncols
+          !              write(*,*) ">>> 1", i, j
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddFloatMatrixDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float matrix to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddFloatMatrixSP(xf, ncols, nrows, dim, matrix, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: ncols               ! the number of cols to be output
+    integer, intent(in)                    :: nrows               ! the number of rows to be output
+    integer, intent(in)                    :: dim                 ! the range of the fastest index
+    real(kind=sp), intent(in)               :: matrix(ncols,nrows) ! the values to be output
+    character(len=*), intent(in), optional :: id                  ! the id
+    character(len=*), intent(in), optional :: title               ! the title
+    character(len=*), intent(in), optional :: dictref             ! the dictionary reference
+    character(len=*), intent(in), optional :: units               ! scienitific units (default ' ')
+    character(len=*), intent(in), optional :: fmt                 ! format
+
+    ! internal variable
+    character(len=10) :: formt
+    integer ::  i, j
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    ! splits data into lines wherever it overflows the workspace
+    ! Flush on entry and exit      
+    !
+    call xml_NewElement(xf, 'matrix')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'cols', str(ncols))
+    call xml_AddAttribute(xf, 'rows', str(nrows))
+    do i = 1, nrows
+       do j = 1, ncols
+          call xml_AddPcdata(xf, str(matrix(j, i)))
+       enddo
+    enddo
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddFloatMatrixSP
+
+
+  ! -------------------------------------------------
+  ! 1. outputs DP lower triangle array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddTriangleDP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue         ! number of values to be output
+    real(kind=dp), intent(in)               :: array(*)        ! the values to be output
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+    character(len=*), intent(in), optional :: units          ! units (' ' = none)
+    character(len=*), intent(in), optional :: fmt            ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    integer           :: size
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    size = (nvalue*(nvalue+1))/2
+    call xml_NewElement(xf, 'array')
+    call xml_AddAttribute(xf, 'size', str(size))
+    call xml_AddAttribute(xf, 'rows', str(nvalue))
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call STMARCF9DP(xf, size, array, formt)
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddTriangleDP
+
+  ! -------------------------------------------------
+  ! 2. outputs SP lower triangle array to xml channel
+  ! -------------------------------------------------
+
+  SUBROUTINE stmAddTriangleSP(xf, nvalue, array, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue         ! number of values to be output
+    real(kind=sp), intent(in)               :: array(*)        ! the values to be output
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+    character(len=*), intent(in), optional :: units          ! units (' ' = none)
+    character(len=*), intent(in), optional :: fmt            ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    ! Flush on entry and exit
+    integer           :: size
+    character(len=10) :: formt
+
+    if (present(fmt)) then
+       formt = fmt
+    else
+       formt = '(f8.3)'
+    endif
+
+    size = (nvalue*(nvalue+1))/2
+    call xml_NewElement(xf, 'array')
+    call xml_AddAttribute(xf, 'size', str(size))
+    call xml_AddAttribute(xf, 'rows', str(nvalue))
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call STMARCF9SP(xf, size, array, formt)
+    call xml_EndElement(xf, 'matrix')
+
+  END SUBROUTINE stmAddTriangleSP
+
+
+  ! -------------------------------------------------
+  ! outputs fatal error message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmErrorMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'fatal')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmErrorMessage
+
+
+  ! -------------------------------------------------
+  ! outputs informational message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmInfoMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'warning')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmInfoMessage
+
+
+  ! -------------------------------------------------
+  ! outputs warning message
+  ! -------------------------------------------------
+
+  SUBROUTINE stmWarningMessage(xf, msg, id, title, dictref)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in)           :: msg            ! the message
+    character(len=*), intent(in), optional :: id             ! the id
+    character(len=*), intent(in), optional :: title          ! the title
+    character(len=*), intent(in), optional :: dictref        ! the dictionary reference
+
+    call xml_NewElement(xf, 'message')
+    call xml_AddAttribute(xf, 'severity', 'info')
+    if (present(id)) call xml_AddAttribute(xf, 'id', id)
+    if (present(title)) call xml_AddAttribute(xf, 'title', title)
+    if (present(dictref)) call xml_AddAttribute(xf, 'dictRef', dictref)
+    call xml_AddPcdata(xf, msg)
+    call xml_EndElement(xf, 'message')
+
+  END SUBROUTINE stmWarningMessage
+
+
+
+  ! =================================================
+  ! basic STMML routines
+  ! =================================================
+
+
+  ! -------------------------------------------------
+  ! creates STMML <scalar> string
+  ! -------------------------------------------------
+
+  SUBROUTINE STMSCAS9(xf, value, id, title, dictref, type)
+
+    implicit none
+    type(xmlf_t) :: xf
+    character(len=*), intent(in) :: value                 ! the value to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: type        ! the data type (default 'xsd:string')
+
+    ! Internal variables
+    character(len=20) :: temp
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(type))    call xml_AddAttribute(xf, 'dataType', type)
+
+!    if (XMLCHKS9(value)) then
+    call xml_AddPcdata(xf, value)
+    call xml_EndElement(xf, 'scalar')
+
+  END SUBROUTINE STMSCAS9
+
+
+
+  ! -------------------------------------------------
+  ! output start tag for an STMML array
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARST9(xf, nvalue, id, title, dictref, typunt, tuval, delim)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue      ! the number of values to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: typunt      ! 'type' (for strings) or 'unit' (for numeric)
+    character(len=*), intent(in), optional :: tuval       ! data type (default 'xsd:string') or units (' ' = none)
+    character(len=*), intent(in), optional :: delim       ! the delimiter (default ' ')
+
+    ! Internal Variables
+    character(len=1) :: delim1
+
+    if (present(delim)) then
+       delim1 = delim
+    else
+       delim1 = ' '
+    endif
+
+    call xml_NewElement(xf, 'array')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(tuval))   call xml_AddAttribute(xf, 'type', tuval)
+    call xml_AddAttribute(xf, 'delimiter', delim1)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call xml_EndElement(xf, 'array')
+
+  END SUBROUTINE STMARST9
+
+
+
+  ! -------------------------------------------------
+  ! 2. outputs SP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARF9SP(xf, nvalue, arrf, id, title, dictref, units, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)                    :: nvalue      ! the number of values to be output
+    real(kind=sp), intent(in)               :: arrf(*)     ! the values to be output
+    character(len=*), intent(in), optional :: id          ! the id
+    character(len=*), intent(in), optional :: title       ! the title
+    character(len=*), intent(in), optional :: dictref     ! the dictionary reference
+    character(len=*), intent(in), optional :: units       ! units (' ' = none)
+    character(len=*)                       :: fmt         ! the output format
+
+    call xml_NewElement(xf, 'scalar')
+    if (present(id))      call xml_AddAttribute(xf, 'id', id)
+    if (present(title))   call xml_AddAttribute(xf, 'dictRef', dictref)
+    if (present(dictref)) call xml_AddAttribute(xf, 'title', title)
+    if (present(units))   call xml_AddAttribute(xf, 'units', units)
+    call xml_AddAttribute(xf, 'size', str(nvalue))
+    call STMARCF9SP(xf, nvalue, arrf, fmt)
+    call xml_NewElement(xf, 'scalar')
+
+  END SUBROUTINE STMARF9SP
+
+
+  ! -------------------------------------------------
+  ! 1. outputs content of DP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARCF9DP(xf, nvalue, arrf, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer, intent(in)          :: nvalue     ! the number of values to be output
+    real(kind=dp), intent(in)     :: arrf(*)    ! the values to be output
+    character(len=*), intent(in) :: fmt        ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    integer :: i
+
+    call xml_AddPcdata(xf, str(arrf(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(arrf(i)))
+    enddo
+  END SUBROUTINE STMARCF9DP
+
+
+  ! -------------------------------------------------
+  ! 2. outputs content of SP float array to channel
+  ! -------------------------------------------------
+
+  SUBROUTINE STMARCF9SP(xf, nvalue, arrf, fmt)
+
+    implicit none
+    type(xmlf_t) :: xf
+    integer          :: nvalue     ! the number of values to be output
+    real(kind=sp)     :: arrf(*)    ! the values to be output
+    character(len=*) :: fmt        ! the output format
+
+    ! splits data into lines whenever it overflows workspace/linelength
+    integer :: i
+
+    call xml_AddPcdata(xf, str(arrf(1)))
+    do i = 2, nvalue
+       call xml_AddPcdata(xf, str(arrf(i)))
+    enddo
+  END SUBROUTINE STMARCF9SP
+
+end module m_stmw
Index: /OBSOLETE/XMLF90/src/dom/flib_dom.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/flib_dom.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/flib_dom.f90	(revision 2354)
@@ -0,0 +1,17 @@
+module flib_dom
+
+  use m_dom_types
+  use m_dom_namednodemap
+  use m_dom_nodelist
+  use m_dom_attribute
+  use m_dom_document
+  use m_dom_node
+  use m_dom_element
+  use m_dom_parse
+  use m_dom_utils
+
+  use m_strings
+
+  public
+
+end module flib_dom
Index: /OBSOLETE/XMLF90/src/dom/m_dom_attribute.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_attribute.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_attribute.f90	(revision 2354)
@@ -0,0 +1,86 @@
+module m_dom_attribute
+
+use m_dom_types
+use m_dom_node
+use m_strings
+
+private
+  !-------------------------------------------------------  
+  ! METHODS FOR ATTRIBUTE NODES
+  !------------------------------------------------------- 
+
+  public :: getName
+  public :: getValue
+  public :: setValue
+
+CONTAINS
+
+  function getName(attribute)
+
+    type(fnode), intent(in) :: attribute
+    type(string)            :: getName
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       getName = attribute%nodeName
+    else
+       getName = ''
+    endif
+
+  end function getName
+
+  !-----------------------------------------------------------
+
+  function getValue(attribute)
+
+    type(fnode), intent(in) :: attribute
+    type(string)            :: getValue
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       getValue = attribute%nodeValue
+    else
+       getValue = ''
+    endif
+
+  end function getValue
+
+  !-----------------------------------------------------------
+
+  subroutine setValue(attribute, value)
+
+    character(len=*), intent(in) :: value
+    type(fnode), pointer  :: attribute
+
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       call setNodeValue(attribute,value)
+    endif
+
+  end subroutine setValue
+
+  !-----------------------------------------------------------
+
+
+!!! NB Is this a good idea?
+!!! NB pure functions have no side effects
+
+  pure function attr_name_len(attribute)
+    type(fnode), intent(in) :: attribute
+    integer :: attr_name_len
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       attr_name_len = len_trim(attribute % nodeName)
+    else
+       attr_name_len = 0
+    end if
+  end function attr_name_len
+  
+  pure function attr_val_len(attribute)   
+    type(fnode), intent(in) :: attribute
+    integer :: attr_val_len
+    if (attribute % nodeType == ATTRIBUTE_NODE) then
+       attr_val_len = len_trim(attribute % nodeValue)
+    else
+       attr_val_len = 0
+    end if
+  end function attr_val_len
+
+
+end module m_dom_attribute
Index: /OBSOLETE/XMLF90/src/dom/m_dom_debug.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_debug.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_debug.f90	(revision 2354)
@@ -0,0 +1,5 @@
+module m_dom_debug
+
+  logical, save, public :: dom_debug = .false.
+
+end module m_dom_debug
Index: /OBSOLETE/XMLF90/src/dom/m_dom_document.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_document.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_document.f90	(revision 2354)
@@ -0,0 +1,113 @@
+module m_dom_document
+
+use m_dom_types
+use m_strings
+
+private
+
+  !-------------------------------------------------------  
+  ! METHODS FOR DOCUMENT NODES
+  !-------------------------------------------------------   
+  public :: createDocumentNode
+  public :: createDocumentFragment
+  public :: createTextNode
+  public :: createAttribute
+  public :: createElement
+  public :: createComment
+  public :: createCdataSection
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  ! METHODS FOR DOCUMENT NODES
+  !-----------------------------------------------------------
+
+  function createDocumentNode()
+
+    type(fnode), pointer :: createDocumentNode
+    
+    createDocumentNode => createNode()
+    createDocumentNode % nodeType = DOCUMENT_NODE
+    createDocumentNode % nodeName = "#document"
+    
+  end function createDocumentNode
+!-------------------------------------------------------------------
+  function createDocumentFragment()
+
+    type(fnode), pointer :: createDocumentFragment
+    
+    createDocumentFragment => createNode()
+    createDocumentFragment % nodeType = DOCUMENT_FRAGMENT_NODE
+    createDocumentFragment % nodeName = "#document-fragment"
+    
+  end function createDocumentFragment
+!-------------------------------------------------------------------
+  function createTextNode(data)
+
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createTextNode
+    
+    createTextNode => createNode()
+    createTextNode % nodeType = TEXT_NODE
+    createTextNode % nodeName = "#text"
+    createTextNode % nodeValue = data  ! NB need to split this string 
+                                       ! across several nodes 
+    
+  end function createTextNode
+
+  !-----------------------------------------------------------
+
+  function createAttribute(name)
+    
+    character(len=*), intent(in) :: name
+    type(fnode), pointer :: createAttribute
+  
+    createAttribute => createNode()
+    createAttribute % nodeName = name
+    createAttribute % nodeType = ATTRIBUTE_NODE
+  
+  end function createAttribute
+
+  !-----------------------------------------------------------
+
+  function createElement(tagName)
+    
+    character(len=*), intent(in) :: tagName
+    type(fnode), pointer :: createElement
+  
+    createElement => createNode()
+    createElement % nodeName = tagName
+    createElement % nodeType = ELEMENT_NODE
+  
+  end function createElement
+
+  !-----------------------------------------------------------
+
+  function createComment(data)
+    
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createComment
+  
+    createComment => createNode()
+    createComment % nodeName = "#comment"
+    createComment % nodeValue = data
+    createComment % nodeType = COMMENT_NODE
+  
+  end function createComment
+
+  !-----------------------------------------------------------
+
+  function createCdataSection(data)
+    
+    character(len=*), intent(in) :: data
+    type(fnode), pointer :: createCdataSection
+  
+    createCdataSection => createNode()
+    createCdataSection % nodeName = "#cdata-section"
+    createCdataSection % nodeValue = data
+    createCdataSection % nodeType = CDATA_SECTION_NODE
+  
+  end function createCdataSection
+
+  
+end module m_dom_document
Index: /OBSOLETE/XMLF90/src/dom/m_dom_element.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_element.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_element.f90	(revision 2354)
@@ -0,0 +1,242 @@
+module m_dom_element
+
+use m_dom_types
+use m_dom_namednodemap
+use m_dom_nodelist
+use m_dom_attribute
+use m_dom_document
+use m_dom_debug
+use m_dom_node
+use m_strings
+
+private
+
+  !-------------------------------------------------------   
+  ! METHODS FOR ELEMENT NODES
+  !-------------------------------------------------------   
+  public :: getTagName
+  public :: getElementsByTagName
+  public :: getAttribute
+  public :: getAttributeNode
+  public :: setAttribute
+  public :: setAttributeNode
+  public :: removeAttribute
+  public :: normalize       !--- combines adjacent text nodes ---!
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  !  METHODS FOR ELEMENT NODES
+  !-----------------------------------------------------------
+  function getTagName(element)
+
+    type(fnode), intent(in) :: element   
+    type(string)            :: getTagName
+
+    if (element % nodeType == ELEMENT_NODE) then
+       getTagName = element % nodeName 
+    else
+       getTagName = ''
+    endif
+
+  end function getTagName
+
+  !-----------------------------------------------------------
+  function getElementsByTagName(element, tag) result(nodelist)
+    type(fnode), pointer         :: element
+    character(len=*), intent(in) :: tag
+    type(fnodeList), pointer     :: nodelist 
+
+    type(fnode), pointer        :: np
+
+    nodelist => null()
+
+    np => element
+    if (dom_debug) print *, "Going into search for tag: ", trim(tag)
+    call search(np)
+
+    CONTAINS
+
+    recursive subroutine search(np)
+    type(fnode), pointer        :: np
+
+    type(string)                :: name
+
+    !
+    ! Could replace the calls to helper methods by direct lookups of node 
+    ! components to make it faster.
+    ! 
+    do
+       if (.not. associated(np)) exit
+       select case(np%nodeType)
+
+          case(DOCUMENT_NODE) 
+             ! special case ... search its children 
+             if (hasChildNodes(np)) call search(getFirstChild(np))
+             ! will exit for lack of siblings
+          case(ELEMENT_NODE)
+
+             name = getNodeName(np)
+             if (dom_debug) print *, "exploring node: ", char(name)
+             if ((tag == "*") .or. (tag == name)) then
+                call append(nodelist,np)
+                if (dom_debug) print *, "found match ", nodelist%length
+             endif
+             if (hasChildNodes(np)) call search(getFirstChild(np))
+
+          case default
+             
+             ! do nothing
+
+        end select
+
+        if (associated(np,element)) exit  ! no siblings of element...
+        np => getNextSibling(np)
+
+     enddo
+    
+    end subroutine search
+
+  end function getElementsByTagName
+
+  !-----------------------------------------------------------
+
+  function getAttribute(element, name)
+    
+    type(fnode), intent(in) :: element
+    character(len=*), intent(in) :: name
+    type(string)                 :: getAttribute
+
+    type(fnode), pointer :: nn
+
+    getAttribute = ""  ! as per specs, if not found
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    nn => getNamedItem(element%attributes,name)
+    if (.not. associated(nn)) RETURN
+    
+    getAttribute = nn%nodeValue
+
+        
+  end function getAttribute
+
+  !-----------------------------------------------------------
+
+  function getAttributeNode(element, name)
+    
+    type(fnode), intent(in) :: element
+    type(fnode), pointer    :: getAttributeNode
+    character(len=*), intent(in) :: name
+
+    getAttributeNode => null()     ! as per specs, if not found
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    getAttributeNode => getNamedItem(element%attributes,name)
+
+  end function getAttributeNode
+  
+  !-----------------------------------------------------------
+
+  subroutine setAttributeNode(element, newattr)
+    type(fnode), pointer :: element
+    type(fnode), pointer :: newattr
+
+    type(fnode), pointer :: dummy
+
+    if (element % nodeType /= ELEMENT_NODE) then
+       if (dom_debug) print *, "not an element node in setAttributeNode..."
+       RETURN
+    endif
+
+    dummy => setNamedItem(element%attributes,newattr)
+     
+  end subroutine setAttributeNode
+
+!-------------------------------------------------------------------
+  subroutine setAttribute(element, name, value)
+    type(fnode), pointer :: element
+    character(len=*), intent(in) :: name
+    character(len=*), intent(in) :: value
+
+    type(fnode), pointer      :: newattr
+
+    newattr => createAttribute(name)
+    call setValue(newattr,value)
+    call setAttributeNode(element,newattr)
+
+  end subroutine setAttribute
+
+  !-----------------------------------------------------------
+
+  subroutine removeAttribute(element, name)
+    type(fnode), pointer :: element
+    character(len=*), intent(in) :: name
+
+    type(fnode), pointer :: dummy
+
+    if (element % nodeType /= ELEMENT_NODE) RETURN
+    if (.not. associated(element%attributes)) RETURN
+
+    dummy => removeNamedItem(element%attributes,name)
+     
+  end subroutine removeAttribute
+
+  !-----------------------------------------------------------
+  recursive subroutine normalize(element)
+    type(fnode), pointer         :: element
+
+    type(fnode), pointer        :: np, ghost
+    logical                     :: first
+
+    type(fnode), pointer        :: head
+
+    first = .true.  ! next Text node will be first
+
+    if (dom_debug) print *, "Normalizing: ", trim(element%nodeName)
+    np => element%firstChild
+    ! 
+    do
+       if (.not. associated(np)) exit
+       select case(np%nodeType)
+
+          case(TEXT_NODE) 
+             if (first) then
+                if (dom_debug) print *, "normalize: found first in chain"
+                head => np
+                first = .false.
+                np => getNextSibling(np)
+             else                    ! a contiguous text node
+                if (dom_debug) print *, "normalize: found second in chain"
+                head%nodeValue = head%nodeValue // np%nodeValue
+                head%nextSibling => np%nextSibling
+                if (associated(np,np%parentNode%lastChild)) then
+                   np%parentNode%lastChild => head
+                   head%nextSibling => null()
+                else
+                   np%nextSibling%previousSibling => head
+                endif
+                ghost => np
+                np => getNextSibling(np)
+                call destroyNode(ghost)
+             endif
+
+          case(ELEMENT_NODE)
+
+             first = .true.
+             if (dom_debug) print *, "element sibling: ", trim(np%nodeName)
+             if (hasChildNodes(np)) call normalize(np)
+             np => getNextSibling(np)
+
+          case default
+             
+             ! do nothing, just mark that we break the chain of text nodes
+             if (dom_debug) print *, "other sibling: ", trim(np%nodeName)
+             first = .true.
+             np => getNextSibling(np)
+
+        end select
+
+     enddo
+
+    end subroutine normalize
+
+
+end module m_dom_element
Index: /OBSOLETE/XMLF90/src/dom/m_dom_error.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_error.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_error.f90	(revision 2354)
@@ -0,0 +1,35 @@
+module m_dom_error
+
+  !-------------------------------------------------------
+  ! EXCEPTION CODES
+  !-------------------------------------------------------
+  integer, parameter, public :: INDEX_SIZE_ERR              = 1
+  integer, parameter, public :: DOMSTRING_SIZE_ERR          = 2
+  integer, parameter, public :: HIERARCHY_REQUEST_ERR       = 3
+  integer, parameter, public :: WRONG_DOCUMENT_ERR          = 4
+  integer, parameter, public :: INVALID_CHARACTER_ERR       = 5
+  integer, parameter, public :: NO_DATA_ALLOWED_ERR         = 6
+  integer, parameter, public :: NO_MODIFICATION_ALLOWED_ERR = 7
+  integer, parameter, public :: NOT_FOUND_ERR               = 8
+  integer, parameter, public :: NOT_SUPPORTED_ERR           = 9
+  integer, parameter, public :: INUSE_ATTRIBUTE_ERR         = 10
+  integer, parameter, public :: INVALID_STATE_ERR           = 11
+  integer, parameter, public :: SYNTAX_ERR                  = 12
+  integer, parameter, public :: INVALID_MODIFICATION_ERR    = 13
+  integer, parameter, public :: NAMESPACE_ERR               = 14
+  integer, parameter, public :: INVALID_ACCESS_ERR          = 15
+  integer, parameter, public :: VALIDATION_ERR              = 16
+  integer, parameter, public :: TYPE_MISMATCH_ERR           = 17
+
+CONTAINS
+
+  subroutine dom_error(name,code,msg)
+    character(len=*), intent(in) :: name, msg
+    integer, intent(in)          :: code
+
+    print *, "***ERROR***"
+    print *, "Routine ", trim(name), ":", trim(msg)
+    print *, 1.0 / sin(3.141592654)
+  end subroutine dom_error
+
+end module m_dom_error
Index: /OBSOLETE/XMLF90/src/dom/m_dom_namednodemap.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_namednodemap.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_namednodemap.f90	(revision 2354)
@@ -0,0 +1,203 @@
+module m_dom_namednodemap
+!
+! This is basically a dictionary module, but written with the
+! DOM node structure in mind.
+!
+use m_dom_types
+use m_strings
+
+private
+  !-------------------------------------------------------  
+  ! METHODS FOR NAMEDNODEMAPS
+  !-------------------------------------------------------   
+  public :: getNamedItem
+  public :: setNamedItem
+  public :: removeNamedItem
+
+  public :: item
+  public :: getLength
+  public :: append
+
+  interface append
+     module procedure append_nnm
+  end interface
+
+  interface item
+     module procedure item_nnm
+  end interface 
+
+  interface getLength
+     module procedure getLength_nnm
+  end interface
+
+CONTAINS
+
+  function item_nnm(namedNodeMap, i)
+    
+    integer, intent(in)             :: i
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    type(fnode), pointer            :: item_nnm
+    
+    type(fnamedNode), pointer :: nnp
+
+    integer :: n
+
+    item_nnm => null()            ! In case there is no such item
+    if (.not. associated(namedNodeMap)) RETURN
+
+    nnp => namedNodeMap%head
+    n = -1
+    do 
+       if (.not. associated(nnp))  exit
+       n = n + 1
+       if (n == i) then
+          item_nnm => nnp%node
+          exit
+       endif
+       nnp => nnp%next
+    enddo
+
+  end function item_nnm
+
+  !----------------------------------------------------------- 
+  
+  function getLength_nnm(namedNodeMap)
+  
+    type(fnamedNodeMap), pointer :: namedNodeMap
+    integer :: getLength_nnm
+
+    getLength_nnm = 0
+    if (.not. associated(namedNodeMap)) return
+
+    getLength_nnm = namedNodeMap % length    
+    
+  end function getLength_nnm
+
+  !----------------------------------------------------------- 
+
+
+  subroutine append_nnm(nodeMap,node)
+    type(fnamednodeMap), pointer :: nodeMap
+    type(fnode), pointer :: node
+
+    if (.not. associated(nodeMap)) then
+       allocate(nodeMap)
+       nodeMap%length = 1
+       allocate(nodeMap%head)
+       nodeMap%head%name = node%nodeName
+       nodeMap%head%node => node
+       nodeMap%tail => nodeMap%head
+    else
+       allocate(nodeMap%tail%next)
+       nodeMap%tail%next%node => node
+       nodeMap%tail%next%name =  node%nodeName
+       nodeMap%tail => nodeMap%tail%next
+       nodeMap%length = nodeMap%length + 1
+    endif
+
+  end subroutine append_nnm
+
+  !----------------------------------------------------------- 
+
+  function getNamedItem(namedNodeMap, name)
+    
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    character(len=*), intent(in)    :: name
+    type(fnode), pointer            :: getNamedItem
+
+    type(fnamedNode), pointer :: nnp
+
+    getNamedItem => null()
+    if (.not. associated(namedNodeMap)) return 
+
+    nnp => namedNodeMap%head
+    do while (associated(nnp)) 
+       if (nnp%name == name) then
+          getNamedItem => nnp%node
+          exit                 ! one or zero nodes with a given name
+       endif
+       nnp => nnp%next
+    enddo
+
+  end function getNamedItem
+
+  
+  function setNamedItem(namedNodeMap, node)
+
+!!AG: Do we need to clone the node ?
+    
+    type(fnamedNodeMap), pointer    :: namedNodeMap
+    type(fnode), pointer            :: node
+    type(fnode), pointer            :: setNamedItem
+
+    type(fnamedNode), pointer :: nnp
+
+    if (.not. associated(namedNodeMap)) then
+
+       call append(namedNodeMap,node)
+       setNamedItem => node
+      
+    else
+
+       nnp => namedNodeMap%head
+       do while (associated(nnp)) 
+          if (nnp%name == node%nodeName) then
+             setNamedItem => nnp%node
+             nnp%node => node
+             setNamedItem => node
+             return
+          endif
+          nnp => nnp%next
+       enddo
+
+       !   If not found, insert it at the end of the linked list
+
+       call append(namedNodeMap,node)
+       setNamedItem => node
+    endif
+
+  end function setNamedItem
+
+!------------------------------------------------------------
+   function removeNamedItem(namedNodeMap, name)
+    
+    type(fnamedNodeMap), pointer   :: namedNodeMap
+    character(len=*), intent(in)   :: name
+    type(fnode), pointer           :: removeNamedItem
+
+    type(fnamedNode), pointer :: nnp, previous
+
+    removeNamedItem => null()
+    if (.not. associated(namedNodeMap)) return  
+
+    previous => null()
+    nnp => namedNodeMap%head
+    do while (associated(nnp)) 
+       if (nnp%name == name) then
+          removeNamedItem => nnp%node
+          if (associated(nnp,namedNodeMap%head)) then
+             ! we remove the first fnamedNode in the chain...
+             namedNodeMap%head => nnp%next
+          else if (.not. associated(nnp%next)) then
+             ! we remove the last fnamedNode in the chain
+             previous%next => null()
+             namedNodeMap%tail => previous
+          else
+             ! we remove a link in the middle of the chain
+             previous%next => nnp%next
+          endif
+          namedNodeMap%length =  namedNodeMap%length - 1
+          call unstring(nnp%name)
+          deallocate(nnp)
+          EXIT                 ! one or zero nodes with a given name
+       endif
+       previous => nnp
+       nnp => nnp%next
+    enddo
+
+  end function removeNamedItem
+
+
+
+end module m_dom_namednodemap
+
Index: /OBSOLETE/XMLF90/src/dom/m_dom_node.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_node.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_node.f90	(revision 2354)
@@ -0,0 +1,560 @@
+module m_dom_node
+
+use m_dom_types
+use m_dom_nodelist
+use m_dom_namednodemap
+use m_dom_debug
+use m_dom_error
+
+use m_strings
+
+private
+
+  !-------------------------------------------------------   
+  ! METHODS FOR NODES
+  !-------------------------------------------------------   
+
+  public :: getNodeName
+  public :: getNodevalue	
+  public :: getNodeType
+  public :: hasChildNodes
+  public :: hasAttributes
+  public :: getParentNode
+  public :: getFirstChild
+  public :: getLastChild
+  public :: getNextSibling
+  public :: getPreviousSibling
+  public :: getOwnerDocument
+  public :: getAttributes
+  public :: getChildNodes
+  public :: setNodeValue
+  public :: appendChild
+  public :: removeChild
+  public :: replaceChild
+  public :: cloneNode  
+  public :: isSameNode
+  public :: insertBefore
+
+  private :: name_len, value_len
+
+CONTAINS
+
+  pure function name_len(node)
+    type(fnode), pointer :: node
+    integer :: name_len
+
+    name_len = len_trim(node % nodeName)
+
+  end function name_len
+
+  pure function value_len(node)
+    type(fnode), pointer :: node
+    integer :: value_len
+
+    value_len = len_trim(node % nodeValue)
+
+  end function value_len
+
+  !-----------------------------------------------------------
+  !  METHODS FOR NODES
+  !-----------------------------------------------------------
+  function getNodeName(node)
+
+    type(fnode), pointer :: node
+!    character(len=len_trim(node%nodeName)) :: getNodeName
+    type(string)  :: getNodeName
+    if (.not. associated(node))  &
+               call dom_error("getNodeName",0,"Node not allocated")
+    getNodeName = node % nodeName
+
+  end function getNodeName
+
+  !-----------------------------------------------------------
+
+  function getNodeValue(node)
+
+    type(fnode), pointer :: node
+!    character(len=len_trim(node%nodeValue)) :: getNodeValue
+    type(string)  :: getNodeValue
+
+    if (.not. associated(node))  &
+               call dom_error("getNodeValue",0,"Node not allocated")
+    getNodeValue = node % nodeValue
+
+  end function getNodeValue
+
+  !-----------------------------------------------------------
+
+  function getNodeType(node)
+
+    type(fnode), pointer :: node
+    integer :: getNodeType
+
+    if (.not. associated(node)) call dom_error("getNodeType",0,"Node not allocated")
+    getNodeType = node % nodeType
+
+  end function getNodeTYpe
+
+  !-----------------------------------------------------------
+
+  function hasChildNodes(node)
+
+    type(fnode), pointer :: node
+    logical :: hasChildNodes
+
+    if (.not. associated(node)) call dom_error("hasChildNodes",0,"Node not allocated")
+    hasChildNodes = associated(node % firstChild)
+
+  end function hasChildNodes
+
+  !-----------------------------------------------------------
+
+  function hasAttributes(node)
+
+    type(fnode), pointer    :: node
+    logical                 :: hasAttributes
+
+    hasAttributes = .false.
+    if (.not. associated(node)) call dom_error("hasAttributes",0,"Node not allocated")
+    if (node % nodeType /= ELEMENT_NODE) RETURN
+    if ( getLength(node%attributes) > 0) hasAttributes = .true.
+
+  end function hasAttributes
+
+  !-----------------------------------------------------------
+
+  function getParentNode(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getParentNode
+
+    if (.not. associated(node)) call dom_error("getParentNode",0,"Node not allocated")
+    getParentNode => node % parentNode
+    
+  end function getParentNode
+  
+  !-----------------------------------------------------------
+
+  function getFirstChild(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getFirstChild
+
+    if (.not. associated(node)) call dom_error("getFirstChild",0,"Node not allocated")
+    getFirstChild => node % firstChild
+
+  end function getFirstChild
+
+  !-----------------------------------------------------------
+
+  function getLastChild(node)
+
+    type(fnode), pointer :: node
+    type(fnode), pointer    :: getLastChild
+
+    if (.not. associated(node)) call dom_error("getLastChild",0,"Node not allocated")
+    getLastChild => node % lastChild
+
+  end function getLastChild
+
+  !-----------------------------------------------------------
+
+  function getNextSibling(node)
+
+    type(fnode), pointer :: node
+    type(fnode), pointer    :: getNextSibling
+
+    if (.not. associated(node)) call dom_error("getNextSibling",0,"Node not allocated")
+    getNextSibling => node % nextSibling
+
+  end function getNextSibling
+
+  !-----------------------------------------------------------
+
+  function getPreviousSibling(node)
+
+    type(fnode), pointer     :: node
+    type(fnode), pointer    :: getPreviousSibling
+
+    if (.not. associated(node)) call dom_error("getPreviousSibling",0,"Node not allocated")
+    getPreviousSibling => node % previousSibling
+
+  end function getPreviousSibling
+
+  !-----------------------------------------------------------
+
+  function getOwnerDocument(node)
+
+    type(fnode), pointer    :: node
+    type(fnode), pointer    :: getOwnerDocument
+
+    if (.not. associated(node)) call dom_error("getOwnerDocument",0,"Node not allocated")
+    getOwnerDocument => node % ownerDocument
+
+  end function getOwnerDocument
+
+  !----------------------------------------------------------- 
+
+  function getChildNodes(node) result(nodelist)
+    
+    type(fnode), pointer        :: node
+    type(fnodeList), pointer    :: nodelist      !!! NB nodeList
+
+    type(fnode), pointer        :: np
+
+    if (.not. associated(node)) call dom_error("getChildNodes",0,"Node not allocated")
+    nodelist => null()
+    np => node%firstChild
+    do 
+       if (.not. associated(np)) exit
+       call append(nodelist,np)
+       np => np%nextSibling
+    enddo
+
+  end function getChildNodes
+
+  !----------------------------------------------------------- 
+
+  function getAttributes(node)
+
+    type(fnode), pointer         :: node
+    type(fnamedNodeMap), pointer :: getAttributes       !!! NB namedNodeMap
+    
+    if (.not. associated(node))  &
+               call dom_error("getAttributes",0,"Node not allocated")
+    getAttributes => node % attributes
+
+  end function getAttributes
+
+  !----------------------------------------------------------- 
+
+  subroutine setNodeValue(node, value)
+
+    type(fnode), pointer :: node
+    character(len=*), intent(in) :: value
+    
+    if (.not. associated(node))  &
+               call dom_error("setNodeValue",0,"Node not allocated")
+
+    select case(node % nodeType)
+
+    case(ATTRIBUTE_NODE)
+       node % nodeValue = trim(value)    !!AG: use just value ??
+
+    case(COMMENT_NODE)
+       node % nodeValue = value
+
+    case(TEXT_NODE)
+       node % nodeValue = value
+
+    case(PROCESSING_INSTRUCTION_NODE)
+       node % nodeValue = value
+
+    case(CDATA_SECTION_NODE)
+       node % nodeValue = value
+
+    end select
+
+  end subroutine setNodeValue
+
+  !-----------------------------------------------------------
+  
+  function appendChild(node, newChild)
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: appendChild
+    
+    if (.not. associated(node))  & 
+               call dom_error("appendChild",0,"Node not allocated")
+
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("appendChild",HIERARCHY_REQUEST_ERR, &
+           "this node cannot have children")
+
+    if (.not.(associated(node % firstChild))) then
+       node % firstChild => newChild
+    else 
+       newChild % previousSibling   => node % lastChild
+       node % lastChild % nextSibling => newChild 
+    endif
+
+    node % lastChild               => newChild
+    newChild % parentNode          => node
+    newChild % ownerDocument       => node % ownerDocument
+    node%nc  = node%nc + 1
+
+    appendChild => newChild
+
+  end function appendChild
+
+  !-----------------------------------------------------------
+  
+  function removeChild(node, oldChild)
+
+    type(fnode), pointer :: removeChild
+    type(fnode), pointer :: node
+    type(fnode), pointer :: oldChild
+    type(fnode), pointer :: np
+    
+    if (.not. associated(node)) call dom_error("removeChild",0,"Node not allocated")
+    np => node % firstChild
+
+    do while (associated(np))
+       if (associated(np, oldChild)) then   ! Two argument form 
+                                              !  of associated()
+          if (associated(np,node%firstChild)) then
+             node%firstChild => np%nextSibling
+             if (associated(np % nextSibling)) then
+                np%nextSibling % previousSibling => null()
+             else
+                node%lastChild => null()    ! there was just 1 node
+             endif
+          else if (associated(np,node%lastChild)) then
+             ! one-node-only case covered above
+             node%lastChild => np%previousSibling
+             np%previousSibling%nextSibling => null()
+          else
+             np % previousSibling % nextSibling => np % nextSibling
+             np % nextSibling % previousSibling => np % previousSibling
+          endif
+          node%nc = node%nc -1
+          np % previousSibling => null()    ! Are these necessary?
+          np % nextSibling => null()
+          np % parentNode => null()
+          removeChild => oldChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("removeChild",NOT_FOUND_ERR,"oldChild not found")
+
+  end function removeChild
+
+ !-----------------------------------------------------------
+  
+  function replaceChild(node, newChild, oldChild)
+
+    type(fnode), pointer :: replaceChild
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: oldChild
+
+    type(fnode), pointer :: np
+    
+    if (.not. associated(node)) call dom_error("replaceChild",0,"Node not allocated")
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("replaceChild",HIERARCHY_REQUEST_ERR, &
+           "this node cannot have children")
+
+    np => node % firstChild
+
+    do while (associated(np))    
+       if (associated(np, oldChild)) then
+          if (associated(np,node%firstChild)) then
+             node%firstChild => newChild
+             if (associated(np % nextSibling)) then
+                oldChild%nextSibling % previousSibling => newChild
+             else
+                node%lastChild => newChild    ! there was just 1 node
+             endif
+          else if (associated(np,node%lastChild)) then
+             ! one-node-only case covered above
+             node%lastChild => newChild
+             oldChild%previousSibling%nextSibling => newChild
+          else
+             oldChild % previousSibling % nextSibling => newChild
+             oldChild % nextSibling % previousSibling => newChild
+          endif
+
+          newChild % parentNode      => oldChild % parentNode
+          newChild % nextSibling     => oldChild % nextSibling
+          newChild % previousSibling => oldChild % previousSibling
+          replaceChild => oldChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("replaceChild",NOT_FOUND_ERR,"oldChild not found")
+
+  end function replaceChild
+
+  !-----------------------------------------------------------
+
+  function cloneNode(node, deep)             
+    type(fnode), pointer :: cloneNode
+    type(fnode), pointer :: node
+
+    logical, optional :: deep
+    logical           :: do_children
+
+    type(fnode), pointer :: original
+    type(fnode), pointer :: parent_clone
+    
+    if (.not. associated(node)) call dom_error("cloneNode",0,"Node not allocated")
+
+    do_children = .false.
+    if (present(deep)) then
+       do_children = deep
+    endif
+    
+    original => node             ! Keep node
+    cloneNode => null()
+    parent_clone => null()
+    call recursive_clone(original, cloneNode)
+    cloneNode%parentNode => null()     ! as per specs   , superfÃluous
+ 
+  Contains
+
+    recursive subroutine recursive_clone(original, cloneNode)
+      type(fnode), pointer :: original        ! node to clone
+      type(fnode), pointer :: cloneNode       ! new node
+
+      type(fnode), pointer :: np, clone
+      type(fnode), pointer :: previous_clone, attr, newattr
+      type(string)         :: name
+      logical :: first_sibling
+      integer :: i
+
+      np => original
+      previous_clone => null()
+      first_sibling = .true.
+      do 
+
+         ! Keep going across siblings
+         ! (2nd and lower levels only)
+
+         if (.not.(associated(np))) EXIT
+
+
+         !----------------------------------------------------!
+         clone => createNode()
+         if (first_sibling) then
+            cloneNode => clone       ! Rest of siblings are chained
+                                     ! automatically, but must not
+                                     ! be aliases of cloneNode !!
+            first_sibling = .false.
+         endif
+         clone % nodeName    = np % nodeName
+         name = np%nodeName
+         if (dom_debug) print *, "Cloning ", char(name)
+         clone % nodeValue   = np % nodeValue
+         clone % nodeType    = np % nodeType
+         clone % ownerDocument => np % ownerDocument
+         clone % parentNode  => parent_clone
+         !
+         ! always deep copy attributes, as per specs
+         ! Note that this will not work for "deep" attributes, with
+         ! hanging entity nodes, etc
+         if (associated(np % attributes)) then
+            do i = 0, getLength(np%attributes) - 1
+               attr => item(np%attributes,i)
+               newattr => createNode()
+               newattr%nodeName = getNodeName(attr)
+               newattr%nodeValue = getNodeValue(attr)
+               newattr%nodeType = ATTRIBUTE_NODE
+               call append(clone%attributes, newattr)
+            enddo
+         endif
+
+         ! Deal with first sibling
+         if (associated(previous_clone)) then
+            if (dom_debug) print *, "linking to previous sibling"
+            previous_clone%nextSibling => clone
+            clone%previousSibling => previous_clone
+         else
+            if (dom_debug) print *, "marking as first child of parent"
+            if (associated(parent_clone))  &
+                           parent_clone%firstChild => clone
+         endif
+
+         ! Deal with last sibling
+         if (.not. associated(np%nextSibling)) then
+            if (dom_debug) print *, "this is the last sibling"
+            if (associated(parent_clone)) then
+               if (dom_debug) print *, "marking as last child of parent"
+               parent_clone%lastChild => clone
+            endif
+         endif
+            
+         if (do_children .and. associated(np%firstChild)) then
+            parent_clone => clone
+            if (dom_debug) print *, ".... going for its children"
+            call recursive_clone(np%firstChild,clone%firstChild)
+            parent_clone => clone%parentNode
+         endif
+
+         if (associated(np,node)) then
+            if (dom_debug) print *, "No more siblings of ", char(name)
+            EXIT  ! no siblings of master node
+         endif
+         np => np % nextSibling
+         previous_clone => clone
+
+      enddo 
+
+    end subroutine recursive_clone
+
+  end function cloneNode
+
+  !-----------------------------------------------------------
+
+  function isSameNode(node1, node2)    ! DOM 3.0
+    type(fnode), pointer :: node1
+    type(fnode), pointer :: node2
+    logical :: isSameNode
+
+    isSameNode = associated(node1, node2)
+
+  end function isSameNode
+
+  !-----------------------------------------------------------
+
+  function insertBefore(node, newChild, refChild)
+    type(fnode), pointer :: insertBefore
+    type(fnode), pointer :: node
+    type(fnode), pointer :: newChild
+    type(fnode), pointer :: refChild
+    type(fnode), pointer :: np
+
+    if (.not. associated(node)) call dom_error("insertBefore",0,"Node not allocated")
+    if ((node%nodeType /= ELEMENT_NODE) .and. &
+        (node%nodeType /= DOCUMENT_NODE)) &
+    call dom_error("insertBefore",HIERARCHY_REQUEST_ERR, &
+           "cannot insert node here")
+
+    if (.not.associated(refChild)) then
+       insertBefore => appendChild(node, newChild)
+       RETURN
+    endif
+
+    np => node % firstChild
+    do while (associated(np))
+       if (associated(np, refChild)) then
+          if (associated(np,node%firstChild)) then
+             node%firstChild => newChild
+          else
+             refChild%previousSibling%nextSibling => newChild
+          endif
+
+          refChild % previousSibling => newChild
+          newChild % nextSibling => refChild
+          newChild % parentNode => node
+          newChild % ownerDocument => refChild % ownerDocument
+          insertBefore => newChild
+          RETURN
+       endif
+       np => np % nextSibling
+    enddo
+
+    call dom_error("insertBefore",NOT_FOUND_ERR,"refChild not found")
+
+  end function insertBefore
+
+!----------------------------------------------------------------------
+
+end module m_dom_node
+
Index: /OBSOLETE/XMLF90/src/dom/m_dom_nodelist.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_nodelist.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_nodelist.f90	(revision 2354)
@@ -0,0 +1,89 @@
+module m_dom_nodelist
+
+use m_dom_types
+
+private
+
+public :: item
+public :: getLength
+public :: append
+
+interface append
+   module procedure append_nl
+end interface
+
+interface item
+   module procedure item_nl
+end interface
+
+interface getLength
+   module procedure getLength_nl
+end interface
+
+CONTAINS
+
+  !-----------------------------------------------------------
+  ! METHODS FOR NODELISTS
+  !-----------------------------------------------------------
+  function item_nl(nodeList, i)
+    
+    integer, intent(in)             :: i
+    type(fnodeList), pointer        :: nodeList
+    type(fnode), pointer            :: item_nl
+    
+    type(flistNode), pointer :: lp
+    integer :: n
+
+    item_nl => null()            ! In case there is no such item
+    if (.not. associated(nodeList)) RETURN
+
+    lp => nodeList%head
+    n = -1
+    do 
+       if (.not. associated(lp))  exit
+       n = n + 1
+       if (n == i) then
+          item_nl => lp%node
+          exit
+       endif
+       lp => lp%next
+    enddo
+
+  end function item_nl
+
+  !----------------------------------------------------------- 
+
+  function getLength_nl(nodeList)
+    
+    type(fnodeList), pointer :: nodeList
+    integer                  :: getLength_nl
+
+    if (.not. associated(nodeList)) then
+       getLength_nl = 0
+    else
+       getLength_nl = nodeList % length
+    endif
+
+  end function getLength_nl
+
+  subroutine append_nl(nodeList,node)
+    type(fnodeList), pointer :: nodeList
+    type(fnode), pointer :: node
+
+    if (.not. associated(nodeList)) then
+       allocate(nodeList)
+       nodelist%length = 1
+       allocate(nodelist%head)
+       nodelist%head%node => node
+       nodelist%tail => nodelist%head
+    else
+       allocate(nodelist%tail%next)
+       nodelist%tail%next%node => node
+       nodelist%tail => nodelist%tail%next
+       nodelist%length = nodelist%length + 1
+    endif
+
+  end subroutine append_nl
+
+end module m_dom_nodelist
+
Index: /OBSOLETE/XMLF90/src/dom/m_dom_parse.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_parse.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_parse.f90	(revision 2354)
@@ -0,0 +1,152 @@
+module m_dom_parse
+
+  use m_dom_types
+  use m_dom_element
+  use m_dom_document
+  use m_dom_node
+!  use m_dom_namednodemap
+  use m_dom_debug
+
+  use flib_sax
+
+  implicit none
+  
+  private
+
+  public :: parsefile
+
+  type(fnode), pointer, private, save  :: main
+  type(fnode), pointer, private, save  :: current
+
+
+CONTAINS
+
+  subroutine begin_element_handler(name,attrs)
+
+    character(len=*),   intent(in) :: name
+    type(dictionary_t), intent(in) :: attrs
+   
+    type(fnode), pointer :: temp
+    character(len=400)   :: attr_name, attr_value
+    integer              :: status
+    integer              :: i
+
+    if (dom_debug) print *, "Adding node for element: ", name
+
+    temp => createElement(name)
+    current => appendChild(current,temp)
+!
+!   Add attributes
+!
+    do i = 1, len(attrs)
+       call get_name(attrs, i, attr_name, status)
+       call get_value(attrs, attr_name, attr_value, status)
+       if (dom_debug) print *, "Adding attribute: ", &
+                       trim(attr_name), ":",trim(attr_value)
+       call setAttribute(current,attr_name,attr_value)
+    enddo
+
+  end subroutine begin_element_handler
+
+!---------------------------------------------------------
+
+  subroutine end_element_handler(name)
+    character(len=*), intent(in)     :: name
+
+!!AG for IBM    type(fnode), pointer :: np
+
+    if (dom_debug) print *, "End of element: ", name
+!!AG for IBM    np => getParentNode(current)
+!!AG for IBM    current => np
+    current => getParentNode(current)
+  end subroutine end_element_handler
+
+!---------------------------------------------------------
+
+  subroutine pcdata_chunk_handler(chunk)
+    character(len=*), intent(in) :: chunk
+
+    type(fnode), pointer :: temp, dummy
+    
+    if (dom_debug) print *, "Got PCDATA: |", chunk, "|"
+
+    temp => createTextNode(chunk)
+    dummy => appendChild(current,temp)
+
+  end subroutine pcdata_chunk_handler
+
+!---------------------------------------------------------
+
+  subroutine comment_handler(comment)
+    character(len=*), intent(in) :: comment
+
+    type(fnode), pointer :: temp, dummy
+
+    if (dom_debug) print *, "Got COMMENT: |", comment, "|"
+
+    temp => createComment(comment)
+    dummy => appendChild(current,temp)
+
+  end subroutine comment_handler
+!---------------------------------------------------------
+  subroutine cdata_section_handler(chunk)
+    character(len=*), intent(in) :: chunk
+
+    type(fnode), pointer :: temp, dummy
+    
+    if (dom_debug) print *, "Got CDATA_SECTION: |", chunk, "|"
+
+    temp => createCdataSection(chunk)
+    dummy => appendChild(current,temp)
+
+  end subroutine cdata_section_handler
+
+!***************************************************
+!   PUBLIC PROCEDURES
+!***************************************************
+
+
+  function parsefile(filename, verbose, sax_verbose)
+
+    character(len=*), intent(in) :: filename
+    logical, intent(in), optional :: verbose
+    logical, intent(in), optional :: sax_verbose
+
+    type(fnode), pointer :: parsefile
+
+    logical :: sax_debug = .false.
+
+    type(xml_t) :: fxml
+    integer :: iostat
+
+    if (present(verbose)) then
+       dom_debug = verbose
+    endif
+
+    if (present(sax_verbose)) then
+       sax_debug = sax_verbose
+    endif
+    
+    call open_xmlfile(filename, fxml, iostat)
+
+    PRINT *,'filename : ',filename
+    if (iostat /= 0) then
+       stop "Cannot open file."
+    endif
+
+    main => createDocumentNode()
+    current => main
+
+    call xml_parse(fxml,  &
+           begin_element_handler, end_element_handler, pcdata_chunk_handler, &
+           comment_handler, cdata_section_handler=cdata_section_handler, &
+           verbose = sax_debug)    
+    call close_xmlfile(fxml)
+
+    parsefile => main
+    if (dom_debug) print *, "Number of allocated nodes: ", getNumberofAllocatedNodes()
+
+  end function parsefile
+
+
+END MODULE m_dom_parse
Index: /OBSOLETE/XMLF90/src/dom/m_dom_types.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_types.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_types.f90	(revision 2354)
@@ -0,0 +1,195 @@
+Module m_dom_types
+
+  use m_strings
+
+  implicit none
+
+  private
+
+  !-------------------------------------------------------   
+  ! A GENERIC NODE
+  !-------------------------------------------------------   
+  type, public :: fnode
+     type(string)         :: nodeName    
+     type(string)         :: nodeValue   
+!!!     character(len=200)    :: nodeName  = ""
+!!!     character(len=200)    :: nodeValue = ""
+     integer              :: nc              = 0 
+     integer              :: nodeType        = 0
+     type(fnode), pointer :: parentNode      => null()
+     type(fnodeList), pointer :: childNodes  => null()  ! New
+     type(fnode), pointer :: firstChild      => null()
+     type(fnode), pointer :: lastChild       => null()
+     type(fnode), pointer :: previousSibling => null()
+     type(fnode), pointer :: nextSibling     => null()
+     type(fnode), pointer :: ownerDocument   => null()
+     type(fnamedNodeMap), pointer :: attributes => null()
+  end type fnode
+
+  !-----------------------------------------------------------
+  !  ONE WAY TO IMPLEMENT A NAMEDNODEMAP  (dictionary)
+  !-----------------------------------------------------------
+
+  ! Linked list of name/node pairs, with overall length variable
+
+  type, public :: fnamedNode
+     type(string)                   :: name
+!!!     character(len=100)            :: name
+     type(fnode), pointer          :: node => null()
+     type(fnamedNode), pointer     :: next => null()
+  end type fnamedNode
+
+  type, public :: fnamedNodeMap
+     integer :: length = 0
+     type(fnamedNode), pointer  :: head => null()
+     type(fnamedNode), pointer  :: tail => null()
+  end type fnamedNodeMap
+
+  !-----------------------------------------------------------
+  !  ONE WAY TO IMPLEMENT A NODELIST 
+  !-----------------------------------------------------------
+
+  type, public :: flistNode
+     type(fnode), pointer          :: node => null()
+     type(flistNode), pointer      :: next => null()
+  end type flistNode
+
+  type, public :: fnodeList
+     integer                      :: length = 0
+     type(flistNode), pointer     :: head => null()
+     type(flistNode), pointer     :: tail => null()
+  end type fnodeList
+
+!========================================================================
+  integer, save, private          :: allocated_nodes = 0
+!========================================================================
+
+  !-------------------------------------------------------   
+  ! NODETYPES
+  !-------------------------------------------------------   
+  integer, parameter, public :: ELEMENT_NODE                = 1
+  integer, parameter, public :: ATTRIBUTE_NODE              = 2
+  integer, parameter, public :: TEXT_NODE                   = 3
+  integer, parameter, public :: CDATA_SECTION_NODE          = 4
+  integer, parameter, public :: ENTITY_REFERENCE_NODE       = 5
+  integer, parameter, public :: ENTITY_NODE                 = 6
+  integer, parameter, public :: PROCESSING_INSTRUCTION_NODE = 7
+  integer, parameter, public :: COMMENT_NODE                = 8
+  integer, parameter, public :: DOCUMENT_NODE               = 9
+  integer, parameter, public :: DOCUMENT_TYPE_NODE          = 10
+  integer, parameter, public :: DOCUMENT_FRAGMENT_NODE      = 11
+  integer, parameter, public :: NOTATION_NODE               = 12
+
+  public :: node_class
+  public :: createNode
+  public :: destroyNode
+  public :: destroyNamedNodeMap
+  public :: destroyNodeList
+  public :: getNumberofAllocatedNodes
+
+CONTAINS
+
+  function getNumberofAllocatedNodes() result(n)
+    integer   :: n
+
+    n = allocated_nodes
+  end function getNumberofAllocatedNodes
+
+!--------------------------------------------------------------
+  function createNode() result(node)
+    type(fnode), pointer  :: node
+
+    allocate(node)
+    allocated_nodes = allocated_nodes + 1
+
+  end function createNode
+!--------------------------------------------------------------
+
+  function node_class(nodetype) result(class)
+    integer, intent(in) :: nodetype
+    character(len=10)  ::     class
+
+    select case(nodetype)
+    case(ELEMENT_NODE)
+       class = "element"
+    case(ATTRIBUTE_NODE)
+       class = "attribute"
+    case(TEXT_NODE)
+       class = "text"
+    case(COMMENT_NODE)
+       class = "comment"
+    case(DOCUMENT_NODE)
+       class = "document"
+    end select
+  end function node_class
+
+  subroutine destroyNamedNodeMap(nodemap)
+    type(fnamedNodeMap), pointer :: nodemap
+
+    type(fnamednode), pointer  :: nnp
+    type(fnode), pointer       :: ghost
+    
+    if (.not. associated(nodemap)) return
+    nnp => nodemap%head
+    do while (associated(nnp))
+       call unstring(nnp%name)
+       ghost => nnp%node
+       nnp => nnp%next
+       call destroyNode(ghost)      ! We might not want to really destroy
+    enddo
+  end subroutine destroyNamedNodeMap
+
+  subroutine destroyNodeList(nodelist)
+    type(fnodeList), pointer :: nodelist
+
+    type(flistnode), pointer   :: p
+    type(fnode), pointer       :: ghost
+    
+    if (.not. associated(nodelist)) return
+    p => nodelist%head
+    do while (associated(p))
+       ghost => p%node
+       p => p%next
+       call destroyNode(ghost)      ! We might not want to really destroy
+    enddo
+  end subroutine destroyNodeList
+
+  recursive subroutine destroyNode(node)
+    type(fnode), pointer  :: node
+    
+    type(fnode), pointer  :: np, ghost
+    
+    np => node
+    do while (associated(np))
+       if (associated(np%firstChild)) then
+          call destroyNode(np%firstChild)
+       endif
+       if (associated(np%attributes)) call destroyNamedNodeMap(np%attributes)
+       call unstring(np%nodeName)
+       call unstring(np%nodeValue)
+       if (associated(np%previousSibling)) & 
+                np%previousSibling%nextSibling => np%nextSibling
+       if (associated(np%nextSibling)) & 
+                np%nextSibling%previousSibling => np%previousSibling
+       if (associated(np%parentNode)) then
+          if (associated(np%parentNode%firstChild,np)) &
+               np%parentNode%firstChild => null()
+          if (associated(np%parentNode%lastChild,np)) &
+               np%parentNode%lastChild => null()
+       endif
+       if (associated(np,node)) then    
+          deallocate(np)
+          allocated_nodes = allocated_nodes - 1
+          EXIT                           ! do not destroy siblings
+       else
+          ghost => np
+          np => np%nextSibling
+          deallocate(ghost)
+          allocated_nodes = allocated_nodes - 1
+       endif
+    enddo
+    node => null()     ! superfluous ?
+  end subroutine destroyNode
+
+end module m_dom_types
+
Index: /OBSOLETE/XMLF90/src/dom/m_dom_utils.f90
===================================================================
--- /OBSOLETE/XMLF90/src/dom/m_dom_utils.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/dom/m_dom_utils.f90	(revision 2354)
@@ -0,0 +1,131 @@
+module m_dom_utils
+
+  use m_dom_types
+  use m_dom_element
+  use m_dom_document
+  use m_dom_node
+  use m_dom_namednodemap
+  use m_dom_debug
+  use m_strings
+
+  use flib_wxml
+
+  public :: dumpTree
+  public :: xmlize
+
+  private
+
+CONTAINS
+
+  subroutine dumpTree(startNode)
+
+    type(fnode), pointer :: startNode   
+
+    character(len=50) :: indent = " "
+    integer           :: indent_level
+    type(string)      :: s
+
+    indent_level = 0
+
+    call dump2(startNode)
+
+  contains
+
+    recursive subroutine dump2(input)
+      type(fnode), pointer :: input
+      type(fnode), pointer :: temp     
+      temp => input
+      do while(associated(temp))
+         s = getNodeName(temp)
+         write(*,'(3a,i3)') indent(1:indent_level), &
+                        char(s), " of type ", &
+                        getNodeType(temp)
+         if (hasChildNodes(temp)) then
+            indent_level = indent_level + 3
+            call dump2(getFirstChild(temp))
+            indent_level = indent_level - 3
+         endif
+         temp => getNextSibling(temp)
+      enddo
+
+    end subroutine dump2
+
+  end subroutine dumpTree
+!----------------------------------------------------------------
+
+  subroutine xmlize(startNode,fname)
+
+    type(fnode), pointer :: startNode   
+    character(len=*), intent(in) :: fname
+
+    type(xmlf_t)  :: xf
+    type(string)  :: s, sv, sn       ! to avoid memory leaks
+
+    call xml_OpenFile(fname,xf)
+    call dump_xml(startNode)
+    call xml_Close(xf)
+
+  contains
+
+    recursive subroutine dump_xml(input)
+      type(fnode), pointer         :: input
+!
+!     Just this node and its descendants, no siblings. 
+!     Of course, the document node has only children...
+!
+      type(fnode), pointer         :: node, attr
+      type(fnamedNodeMap), pointer :: attr_map
+      integer  ::  i
+
+      node => input
+      do
+         if (.not. associated(node)) exit
+         select case (getNodeType(node))
+
+          case (DOCUMENT_NODE)
+
+             call xml_AddXMLDeclaration(xf)
+             if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+
+          case (ELEMENT_NODE)
+
+             s = getNodeName(node)
+             call xml_NewElement(xf,char(s))
+             attr_map => getAttributes(node)
+             do i = 0, getLength(attr_map) - 1
+                attr => item(attr_map,i)
+                sn = getNodeName(attr)
+                sv = getNodeValue(attr)
+                call xml_AddAttribute(xf, char(sn),char(sv))
+             enddo
+             if (hasChildNodes(node)) call dump_xml(getFirstChild(node))
+             s = getNodeName(node)
+             call xml_EndElement(xf,char(s))
+
+          case (TEXT_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddPcdata(xf,char(s))
+
+          case (CDATA_SECTION_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddCdataSection(xf,char(s))
+
+          case (COMMENT_NODE)
+             
+             s = getNodeValue(node)
+             call xml_AddComment(xf,char(s))
+
+        end select
+        if (associated(node,StartNode)) exit  ! In case we request the 
+                                              ! dumping of a single element,
+                                              ! do not do siblings
+        node => getNextSibling(node)
+     enddo
+
+    end subroutine dump_xml
+
+  end subroutine xmlize
+
+end module m_dom_utils
Index: /OBSOLETE/XMLF90/src/sax/CHANGES
===================================================================
--- /OBSOLETE/XMLF90/src/sax/CHANGES	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/CHANGES	(revision 2354)
@@ -0,0 +1,28 @@
+April 28, 2004
+
+* New optional argument "record_size" in open_xmlfile. The default record 
+length is 65536, but for overly long lines it might be necessary to specify
+a larger size.
+
+* Wrote "init_" routines to avoid undefined status for the components
+of the buffer, dictionary, and elstack derived types (Fortran90 restriction). 
+They are called just once at the beginning of execution.
+
+The "reset_" routines just zero out the counters in the derived
+types. This leads to substantial savings in overhead.
+
+* Avoided when possible the allocation of temporaries (mostly strings) by
+the compilers. This was particularly acute in the "action" records. The
+typical idiom:
+
+	action =trim("Reading character in name: " // c)
+
+forced the allocation of a temporary.  The number of compiler allocations
+(at least with NAG) has dropped down to just those needed in the processing
+of entities.
+
+* Put the explicit module dependencies in the makefile.
+
+* Increased the standard size of the buffers and dictionaries.
+***** The program now stops when those sizes are not enough.
+
Index: /OBSOLETE/XMLF90/src/sax/Developer.Guide
===================================================================
--- /OBSOLETE/XMLF90/src/sax/Developer.Guide	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/Developer.Guide	(revision 2354)
@@ -0,0 +1,61 @@
+Developer Notes:
+
+The parser is built on several levels:
+
+1. The closest to the user.
+
+   Modules:  m_xml_parser: The main module
+             m_error     : Basic error handling
+
+2. An intermediate layer.
+
+   Modules: m_fsm  (A finite-state machine to parse the input)
+
+3. A layer defining basic data structures and file interfaces:
+
+   Modules: m_reader:  File interface and character handling as per XML specs.
+	    m_buffer:  Basic homemade "variable length string", with some
+                       limitations (size, of course), but avoiding the
+                       use of dynamic structures for now.
+	    m_dictionary: Simple, not dynamic.
+            m_charset: A simple hashing method for sets of characters.
+	    m_elstack: Simple stack to check well-formedness.
+	    m_entities: Entity replacement utilities.
+
+4. Something which does not really belong in the parser but which
+   is useful to massage the data extracted from the file:
+
+	m_converters: Routines to turn pcdata chunks into numerical arrays
+
+
+There are obviously a number of hardwired limitations, which should be
+removed in a later version:
+
+* Buffer size in buffer_t definition. This is not as serious as it
+  looks. Only long unbroken pcdata sections and overly long attribute
+  names or values will be affected. Long SGML declarations and comments
+  might be truncated, but they are not relevant anyway.
+
+* Maximum number of attributes in an element tag (set in m_dictionary)
+
+While the parser does not use any variable-length strings (to keep it
+compatible with existing Fortran90 compilers) or dynamical data
+structures for attribute dictionaries, etc, such improvements could be
+incorporated almost as drop-in replacements for existing sub-modules.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/TODO
===================================================================
--- /OBSOLETE/XMLF90/src/sax/TODO	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/TODO	(revision 2354)
@@ -0,0 +1,7 @@
+Things to do:
+
+* Make buffer pseudo-dynamical to avoid limitations.
+* Insert code to deal with XML declarations (really processing instructions)
+  which are not of the form
+  
+ <?name  pseudo_att_name="pseudo_att_value" .... ?>
Index: /OBSOLETE/XMLF90/src/sax/flib_sax.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/flib_sax.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/flib_sax.f90	(revision 2354)
@@ -0,0 +1,19 @@
+module flib_sax
+
+!
+! Stub module to gather all the functionality needed by the user
+! 
+! In future m_dictionary and m_converters could be exported by
+! other parts of a more general fortran library.
+!
+! m_xml_error is necessary in order to use a custom error handler.
+!
+use m_dictionary
+use m_xml_parser
+use m_converters
+use m_xml_error
+
+public
+
+end module flib_sax
+
Index: /OBSOLETE/XMLF90/src/sax/m_buffer.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_buffer.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_buffer.f90	(revision 2354)
@@ -0,0 +1,200 @@
+module m_buffer
+
+!
+! At this point we use a fixed-size buffer. 
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in m_fsm to avoid buffer overflows
+! caused by pcdata with whitespace.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public   :: MAX_BUFF_SIZE  = 10000
+integer, parameter, private  :: BUFF_SIZE_WARNING  = 900
+
+!
+
+type, public  :: buffer_t
+private
+      integer                       :: size
+      character(len=MAX_BUFF_SIZE)  :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, len       !! , char
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer, init_buffer
+public :: buffer_to_character
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+      module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+      module procedure compare_buffers, compare_buffer_str, &
+             compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+      module procedure buffer_to_str
+end interface
+interface char                 ! Experimental
+      module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+   module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal)     ! .equal. generic
+type(buffer_t), intent(in)  :: a
+type(buffer_t), intent(in)  :: b
+logical                     :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in)   :: buffer
+character(len=*), intent(in) :: str
+logical                      :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in)   :: buffer
+logical                     :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in)   :: c
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!!  RETURN
+!
+!  It will only affect long comments and sgml declarations
+   STOP "sax 1 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in)   :: s
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+!!  RETURN
+!
+!  It will only affect long comments and sgml declarations
+  STOP "sax 2 Buffer overflow: long unbroken string of pcdata or attribute value..."
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine init_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+
+buffer%size = 0
+buffer%str=""               ! To avoid "undefined" status
+
+end subroutine init_buffer
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+  buffer%size = 0
+end subroutine reset_buffer
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in)  :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in)          :: buffer
+character(len=buffer%size)          :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+!
+subroutine buffer_to_character(buffer,str)
+type(buffer_t), intent(in)          :: buffer
+character(len=*), intent(out)       :: str
+
+str = buffer%str(1:buffer%size)
+end subroutine buffer_to_character
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in)          :: buffer
+logical                             :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in)          :: buffer
+integer                             :: length
+
+length = buffer%size 
+
+end function buffer_length
+
+
+end module m_buffer
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_charset.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_charset.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_charset.f90	(revision 2354)
@@ -0,0 +1,203 @@
+module m_charset
+!
+! One-byte only, sorry
+!
+private
+
+integer, parameter, private  :: small_int = selected_int_kind(1)
+
+!--------------------------------------------------------------------------
+type, public :: charset_t
+! private
+      integer(kind=small_int), dimension(0:255) :: mask
+end type charset_t
+
+
+public  :: operator(.in.), operator(+)
+public  :: assignment(=)
+public  :: print_charset, reset_charset
+
+interface operator(.in.)
+      module procedure belongs
+end interface
+private :: belongs
+
+interface assignment(=)
+      module procedure set_string_to_charset, set_codes_to_charset
+end interface
+private ::  set_string_to_charset, set_codes_to_charset
+
+interface operator(+)
+      module procedure add_string_to_charset, &
+                       add_code_to_charset, add_codes_to_charset
+end interface
+private :: add_string_to_charset, add_code_to_charset, add_codes_to_charset
+
+!--------------------------------------------------------------------------
+
+character(len=*), parameter, private :: &
+            lowercase = "abcdefghijklmnopqrstuvwxyz",  & 
+            uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", &
+            digits    = "0123456789"
+
+integer, parameter, public   :: SPACE           = 32
+integer, parameter, public   :: NEWLINE         = 10
+integer, parameter, public   :: CARRIAGE_RETURN = 13
+integer, parameter, public   :: TAB             =  9
+
+type(charset_t), public    :: initial_name_chars
+type(charset_t), public    :: name_chars
+type(charset_t), public    :: whitespace
+type(charset_t), public    :: valid_chars
+type(charset_t), public    :: uppercase_chars
+
+public  :: setup_xml_charsets
+
+
+CONTAINS !==========================================================
+
+!--------------------------------------------------------------
+function belongs(c,charset)  result(res)
+character(len=1), intent(in)  :: c
+type(charset_t), intent(in)   :: charset
+logical                       :: res
+
+integer  :: code
+
+code = ichar(c)
+res = (charset%mask(code) == 1)
+
+end function belongs
+
+!--------------------------------------------------------------
+
+function add_string_to_charset(charset,str)  result (sum)
+type(charset_t), intent(in)      :: charset
+character(len=*), intent(in)     :: str
+type(charset_t)                  :: sum
+
+integer :: length, code, i
+
+sum%mask = charset%mask
+
+length = len_trim(str)
+do i = 1, length
+      code = ichar(str(i:i))
+      sum%mask(code) = 1
+enddo
+end function add_string_to_charset
+
+!--------------------------------------------------------------
+
+function add_code_to_charset(charset,code) result(sum)
+type(charset_t), intent(in)      :: charset
+integer, intent(in)              :: code
+type(charset_t)                  :: sum
+
+if ((code > 255) .or. (code < 0)) return
+sum%mask = charset%mask
+sum%mask(code) = 1
+
+end function add_code_to_charset
+
+!--------------------------------------------------------------
+function add_codes_to_charset(charset,codes) result(sum)
+type(charset_t), intent(in)        :: charset
+integer, dimension(:), intent(in)  :: codes
+type(charset_t)                    :: sum
+
+integer  :: i
+
+sum%mask = charset%mask
+do i = 1, size(codes)
+      if ((codes(i) > 255) .or. (codes(i) < 0)) cycle
+      sum%mask(codes(i)) = 1
+enddo
+end function add_codes_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_string_to_charset(charset,str)      
+type(charset_t), intent(out)   :: charset
+character(len=*), intent(in)   :: str
+
+
+integer :: length, code, i
+
+charset%mask = 0
+
+length = len_trim(str)
+do i = 1, length
+      code = ichar(str(i:i))
+      charset%mask(code) = 1
+enddo
+
+end subroutine set_string_to_charset
+
+!--------------------------------------------------------------
+
+subroutine set_codes_to_charset(charset,codes)      
+type(charset_t), intent(out)   :: charset
+integer, dimension(:), intent(in)  :: codes
+
+integer :: i
+
+charset%mask = 0
+
+do i = 1, size(codes)
+      charset%mask(codes(i)) = 1
+enddo
+
+end subroutine set_codes_to_charset
+
+
+!--------------------------------------------------------------
+subroutine print_charset(charset)      
+type(charset_t), intent(in)   :: charset
+
+integer :: i
+
+do i = 0, 255
+      if (charset%mask(i) == 1) print *, "Code: ", i
+enddo
+end subroutine print_charset
+
+!--------------------------------------------------------------
+
+subroutine reset_charset(charset)      
+type(charset_t), intent(inout)   :: charset
+
+integer :: i
+
+do i = 0, 255
+      charset%mask(i) = 0
+enddo
+end subroutine reset_charset
+
+!--------------------------------------------------------------
+
+!--------------------------------------------------------
+subroutine setup_xml_charsets()
+
+integer :: i
+
+uppercase_chars = uppercase
+initial_name_chars = (lowercase  // uppercase //  "_:" )
+name_chars = initial_name_chars + ( digits // ".-")
+whitespace = (/ SPACE, NEWLINE, TAB, CARRIAGE_RETURN /)
+
+valid_chars = whitespace + (/ (i, i=33,255) /)
+
+end subroutine setup_xml_charsets
+!--------------------------------------------------------
+
+end module m_charset
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_converters.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_converters.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_converters.f90	(revision 2354)
@@ -0,0 +1,180 @@
+module m_converters
+
+use m_debug
+
+private
+!
+! Takes a string and turns it into useful data structures,
+! such as numerical arrays.
+!
+! NOTE: The string must contain *homogeneous* data, i.e.: all real numbers,
+! all integers, etc.
+!
+public :: build_data_array
+
+interface build_data_array
+      module procedure build_data_array_real_sp,  &
+                       build_data_array_real_dp,  &
+                       build_data_array_integer
+end interface
+private :: build_data_array_real_sp
+private :: build_data_array_real_dp
+private :: build_data_array_integer
+
+private :: token_analysis, is_separator, is_CR_or_LF
+
+CONTAINS
+
+!---------------------------------------------------------------
+subroutine build_data_array_real_dp(str,x,n)
+integer, parameter  :: dp = selected_real_kind(14)
+!
+character(len=*), intent(in)                ::  str
+real(kind=dp), dimension(:), intent(inout)  ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_dp
+!---------------------------------------------------------------
+
+subroutine build_data_array_real_sp(str,x,n)
+integer, parameter  :: sp = selected_real_kind(6)
+!
+character(len=*), intent(in)                :: str
+real(kind=sp), dimension(:), intent(inout)  ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "real conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_real_sp
+
+!---------------------------------------------------------------
+subroutine build_data_array_integer(str,x,n)
+integer, parameter  :: sp = selected_real_kind(14)
+!
+character(len=*), intent(in)                :: str
+integer, dimension(:), intent(inout)        ::    x
+integer, intent(inout)                      ::    n
+
+integer                            :: ntokens, status, last_pos
+character(len=len(str))  :: s
+
+s = str
+call token_analysis(s,ntokens,last_pos)
+if (debug) print *, "ntokens, last_pos ", ntokens, last_pos
+if (debug) print *, s
+if ((n + ntokens) > size(x)) STOP "data array full"
+read(unit=s(1:last_pos),fmt=*,iostat=status) x(n+1:n+ntokens)
+if (status /= 0) STOP "integer conversion error"
+n = n + ntokens
+
+end subroutine build_data_array_integer
+
+
+!==================================================================
+
+function is_separator(c) result(sep)
+character(len=1), intent(in)          :: c
+logical                               :: sep
+
+ sep = ((c == char(32)) .or. (c == char(10))             &
+         .or. (c == char(9)) .or. (c == char(13)))
+
+end function is_separator
+!----------------------------------------------------------------
+function is_CR_or_LF(c) result(res)
+character(len=1), intent(in)          :: c
+logical                               :: res
+
+ res = ((c == char(10)) .or. (c == char(13)))
+
+end function is_CR_or_LF
+
+!==================================================================
+
+subroutine token_analysis(str,ntokens,last_pos)
+!
+character(len=*), intent(inout)          :: str
+integer, intent(out)                     :: ntokens, last_pos
+!
+!
+! Checks the contents of a string and finds the number of tokens it contains
+! The standard separator is generalized whitespace (space, tab, CR, or LF)
+! It also returns the last useful position in the string (excluding
+! separator characters which are not blanks, and thus not caught by the
+! (len_)trim fortran intrinsic). This is necessary to perform list-directed
+! I/O in the string as an internal file.
+! 
+! Also, replace on the fly CR and LF by blanks. This is necessary if
+! str spans more than one record. In that case, internal reads only 
+! look at the first record. 
+! -- ** Compiler limits on size of internal record??
+!
+integer           :: i, str_length
+logical           :: in_token
+character(len=1)  :: c
+
+in_token = .false.
+ntokens = 0
+last_pos = 0
+
+str_length = len_trim(str)
+!print *, "string length: ", str_length
+
+do i = 1, str_length
+      c = str(i:i)
+
+      if (in_token) then
+         if (is_separator(c)) then
+            in_token = .false.
+            if (is_CR_or_LF(c)) str(i:i) = " "
+         else
+            last_pos = i
+         endif
+
+      else   ! not in token
+         
+         if (is_separator(c)) then
+            if (is_CR_or_LF(c)) str(i:i) = " "
+            ! do nothing
+         else
+            in_token = .true.
+            last_pos = i
+            ntokens = ntokens + 1
+         endif
+      endif
+enddo
+!print *, "ntokens, last_pos: ", ntokens, last_pos
+
+end subroutine token_analysis
+
+
+end module m_converters
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_debug.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_debug.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_debug.f90	(revision 2354)
@@ -0,0 +1,5 @@
+module m_debug
+
+logical, public, save   :: debug = .false.
+
+end module m_debug
Index: /OBSOLETE/XMLF90/src/sax/m_dictionary.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_dictionary.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_dictionary.f90	(revision 2354)
@@ -0,0 +1,183 @@
+module m_dictionary
+
+use m_buffer
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private    :: MAX_ITEMS = 64
+type, public :: dictionary_t
+private
+      integer                               :: number_of_items
+      type(buffer_t), dimension(MAX_ITEMS)  :: key
+      type(buffer_t), dimension(MAX_ITEMS)  :: value
+end type dictionary_t
+
+!
+! Building procedures
+!
+public  :: add_key_to_dict, add_value_to_dict, init_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public  :: len
+interface len
+   module procedure number_of_entries
+end interface
+public  :: number_of_entries
+public  :: get_key
+public  :: get_value
+public  :: has_key
+public  :: print_dict
+!
+public  :: get_name
+
+interface get_name
+   module procedure get_key
+end interface
+
+interface get_value
+   module procedure sax_get_value
+end interface
+private :: sax_get_value
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(dictionary_t), intent(in)   :: dict
+integer                          :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(dictionary_t), intent(in)   :: dict
+character(len=*), intent(in)     :: key
+logical                          :: found
+
+integer  :: n, i
+found = .false.
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) .EQUAL. key) then
+         found = .true.
+         exit
+      endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine sax_get_value(dict,key,value,status)
+type(dictionary_t), intent(in)            :: dict
+character(len=*), intent(in)              :: key
+character(len=*), intent(out)             :: value
+integer, intent(out)                      :: status
+!
+integer  :: n, i
+
+status = -1
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) .EQUAL. key) then
+         value = str(dict%value(i))
+         status = 0
+         RETURN
+      endif
+enddo
+
+end subroutine sax_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(dictionary_t), intent(in)            :: dict
+integer, intent(in)                       :: i
+character(len=*), intent(out)             :: key
+integer, intent(out)                      :: status
+
+if (i <= dict%number_of_items) then
+      key = str(dict%key(i))
+      status = 0
+else
+      key = ""
+      status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+type(buffer_t), intent(in)          :: key
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+      write(unit=0,fmt=*) "Dictionary capacity exceeded ! size= ", max_items
+      RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+type(buffer_t), intent(in)          :: value
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine init_dict(dict)
+type(dictionary_t), intent(inout)   :: dict
+
+integer  :: i
+
+dict%number_of_items = 0
+do i=1, MAX_ITEMS                      ! To avoid "undefined" status
+   call init_buffer(dict%key(i))       ! (Fortran90 restriction)
+   call init_buffer(dict%value(i))
+enddo
+end subroutine init_dict
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(dictionary_t), intent(inout)   :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(dictionary_t), intent(in)   :: dict
+
+integer  :: i
+
+do i = 1, dict%number_of_items
+      print *, trim(str(dict%key(i))), " = ", trim(str(dict%value(i)))
+enddo
+
+end subroutine print_dict
+
+
+end module m_dictionary
Index: /OBSOLETE/XMLF90/src/sax/m_elstack.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_elstack.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_elstack.f90	(revision 2354)
@@ -0,0 +1,153 @@
+module m_elstack
+
+use m_buffer
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private            :: STACK_SIZE = 40
+
+type, public :: elstack_t
+private
+      integer                                :: n_items
+      type(buffer_t), dimension(STACK_SIZE)  :: data
+end type elstack_t
+
+public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public  :: init_elstack
+public  :: get_top_elstack, is_empty, get_elstack_signature
+
+interface is_empty
+      module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine init_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE                   ! to avoid "undefined status"
+      call init_buffer(elstack%data(i))
+enddo
+end subroutine init_elstack
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+integer :: i
+
+elstack%n_items = 0
+do i = 1, STACK_SIZE                  
+      call reset_buffer(elstack%data(i))
+enddo
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in)  :: elstack
+logical                    :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+type(buffer_t), intent(in)      :: item
+type(elstack_t), intent(inout)  :: elstack
+
+integer   :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+      stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout)     :: elstack
+type(buffer_t), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in)        :: elstack
+type(buffer_t), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in)   :: elstack
+integer, intent(in)           :: unit
+integer   :: i
+
+do i = elstack%n_items, 1, -1
+      write(unit=unit,fmt=*) str(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in)   :: elstack
+character(len=*), intent(out) :: string
+integer   :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+   length = len(elstack%data(i))
+   string(j+1:j+1) = "/"
+   j = j+1
+   string(j+1:j+length) = str(elstack%data(i))
+   j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_elstack
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_entities.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_entities.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_entities.f90	(revision 2354)
@@ -0,0 +1,134 @@
+module m_entities
+!
+! Entity management
+!
+! It deals with: 
+!    1. The five standard entities (gt,lt,amp,apos,quot)
+!    2. Character entities  (but only within the range of the char intrinsic)
+!
+use m_buffer
+private
+
+integer, parameter, private      :: MAX_REPLACEMENT_SIZE = 200
+!
+type, private :: entity_t
+ character(len=40)                     :: code
+ character(len=MAX_REPLACEMENT_SIZE)   :: replacement
+end type entity_t
+
+integer, parameter, private                          ::  N_ENTITIES  = 5
+
+type(entity_t), private, dimension(N_ENTITIES), save :: predefined_ent =  &
+      (/                  &
+      entity_t("gt",">"), &
+      entity_t("lt","<"),  &
+      entity_t("amp","&"),  &
+      entity_t("apos","'"),  &
+      entity_t("quot","""")  &
+      /)
+      
+public :: code_to_str , entity_filter
+
+CONTAINS
+
+subroutine code_to_str(code,str,status)
+character(len=*), intent(in)  :: code
+character(len=*), intent(out) :: str
+integer, intent(out)          :: status         
+integer :: i
+
+integer   :: number, ll
+character(len=4)  :: fmtstr
+
+status = -1
+do i = 1, N_ENTITIES
+      if (code == predefined_ent(i)%code) then
+         str = predefined_ent(i)%replacement
+         status = 0
+         return
+      endif
+enddo
+!
+! Replace character references  (but only within the range of the
+! char intrinsic !!)
+!
+if (code(1:1) == "#") then
+   if (code(2:2) == "x") then       ! hex character reference
+      ll = len_trim(code(3:))
+      write(unit=fmtstr,fmt="(a2,i1,a1)") "(Z", ll,")"
+      read(unit=code(3:),fmt=fmtstr) number
+      str = char(number)
+      status = 0
+      return
+   else                             ! decimal character reference
+      read(unit=code(2:),fmt=*) number
+      str = char(number)
+      status = 0
+      return
+   endif
+endif
+
+end subroutine code_to_str
+
+!----------------------------------------------------------------
+!
+! Replaces entity references in buf1 and creates a new buffer buf2.
+!
+subroutine entity_filter(buf1,buf2,status,message)
+type(buffer_t), intent(in)    :: buf1
+type(buffer_t), intent(out)   :: buf2
+integer, intent(out)          :: status
+character(len=*), intent(out) :: message
+!
+! Replaces entity references by their value
+!
+integer :: i, k, len1
+character(len=MAX_BUFF_SIZE)           :: s1
+character(len=1)                       :: c
+character(len=MAX_REPLACEMENT_SIZE)    :: repl
+
+call buffer_to_character(buf1,s1)        !! Avoid allocation of temporary
+len1 = len(buf1)
+
+i = 1
+status = 0
+
+call reset_buffer(buf2)
+
+do
+   if (i > len1) exit
+   c = s1(i:i)
+   if (c == "&") then
+      if (i+1 > len1) then
+         status = -i
+         message=  " Unmatched & in entity reference"
+         return
+      endif
+      k = index(s1(i+1:),";")
+      if (k == 0) then
+         status = -i
+         message=  " Unmatched & in entity reference"
+         return
+      endif
+      call code_to_str(s1(i+1:i+k-1),repl,status)
+      if (status /= 0) then
+         status =  i     ! Could let it continue
+         message= "Ignored unknown entity: &" // s1(i+1:i+k-1) // ";"
+      else
+         call add_to_buffer(trim(repl),buf2)
+      endif
+      i = i + k + 1
+   else
+     call add_to_buffer(c,buf2)
+     i = i + 1
+   endif
+enddo
+
+end subroutine entity_filter
+
+end module m_entities
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_fsm.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_fsm.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_fsm.f90	(revision 2354)
@@ -0,0 +1,745 @@
+module m_fsm
+!
+use m_buffer
+use m_dictionary
+use m_charset
+use m_entities
+use m_elstack
+
+private
+
+type, public :: fsm_t
+      !
+      ! Contains information about the "finite state machine"
+      ! Some of the components (marked *) could at this point be made into
+      ! saved module variables.
+      ! 
+      !
+      integer              :: state
+      integer              :: context
+      integer              :: nbrackets             !*
+      integer              :: nlts                  !*
+      character(len=1)     :: quote_char            !*
+      type(buffer_t)       :: buffer                !*
+      type(buffer_t)       :: element_name
+      type(dictionary_t)   :: attributes
+      type(buffer_t)       :: pcdata
+      type(elstack_t)      :: element_stack
+      logical              :: root_element_seen
+      type(buffer_t)       :: root_element_name
+      character(len=150)   :: action
+      logical              :: debug
+end type fsm_t
+
+public :: init_fsm, reset_fsm, evolve_fsm
+
+!
+! State parameters
+!
+integer, parameter, public   ::  ERROR = -1
+integer, parameter, public   ::  INIT = 1         
+integer, parameter, private  ::  START_TAG_MARKER = 2
+integer, parameter, private  ::  END_TAG_MARKER = 3
+integer, parameter, private  ::  IN_NAME = 4
+integer, parameter, private  ::  WHITESPACE_IN_TAG = 5
+integer, parameter, private  ::  IN_PCDATA = 6
+integer, parameter, private  ::  SINGLETAG_MARKER = 7
+integer, parameter, private  ::  CLOSINGTAG_MARKER = 8
+integer, parameter, private  ::  IN_COMMENT = 9
+integer, parameter, private  ::  IN_ATT_NAME = 10
+integer, parameter, private  ::  IN_ATT_VALUE = 11
+integer, parameter, private  ::  EQUAL = 12
+integer, parameter, private  ::  SPACE_AFTER_EQUAL = 13
+integer, parameter, private  ::  SPACE_BEFORE_EQUAL = 14
+integer, parameter, private  ::  START_QUOTE = 15
+integer, parameter, private  ::  END_QUOTE = 16
+integer, parameter, private  ::  BANG = 17
+integer, parameter, private  ::  BANG_HYPHEN = 18
+integer, parameter, private  ::  ONE_HYPHEN = 19
+integer, parameter, private  ::  TWO_HYPHEN = 20
+integer, parameter, private  ::  QUESTION_MARK = 21
+integer, parameter, private  ::  START_XML_DECLARATION = 22
+integer, parameter, private  ::  IN_SGML_DECLARATION = 23
+integer, parameter, private  ::  IN_CDATA_SECTION = 24
+integer, parameter, private  ::  ONE_BRACKET = 25
+integer, parameter, private  ::  TWO_BRACKET = 26
+integer, parameter, private  ::  CDATA_PREAMBLE = 27
+integer, parameter, private  ::  IN_PCDATA_AT_EOL = 30
+!
+! Context parameters
+!
+integer, parameter, public   ::  OPENING_TAG  = 100
+integer, parameter, public   ::  CLOSING_TAG  = 110
+integer, parameter, public   ::  SINGLE_TAG   = 120
+integer, parameter, public   ::  COMMENT_TAG  = 130
+integer, parameter, public   ::  XML_DECLARATION_TAG  = 140
+integer, parameter, public   ::  SGML_DECLARATION_TAG  = 150
+integer, parameter, public   ::  CDATA_SECTION_TAG  = 160
+integer, parameter, public   ::  NULL_CONTEXT          = 200
+!
+! Signal parameters
+!
+integer, parameter, public   ::  QUIET             = 1000
+integer, parameter, public   ::  END_OF_TAG        = 1100
+integer, parameter, public   ::  CHUNK_OF_PCDATA   = 1200
+integer, parameter, public   ::  EXCEPTION         = 1500
+
+CONTAINS
+
+!------------------------------------------------------------
+! Initialize once and for all the derived types (Fortran90 restriction)
+!
+subroutine init_fsm(fx) 
+type(fsm_t), intent(inout)   :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call init_elstack(fx%element_stack)
+ fx%root_element_seen = .false.
+ fx%debug = .false.
+ fx%action = ""
+ call init_buffer(fx%buffer)
+ call init_buffer(fx%element_name)
+ call init_buffer(fx%pcdata)
+ call init_buffer(fx%root_element_name)
+ call init_dict(fx%attributes)
+end subroutine init_fsm
+!------------------------------------------------------------
+subroutine reset_fsm(fx) 
+type(fsm_t), intent(inout)   :: fx
+
+ fx%state = INIT
+ call setup_xml_charsets()
+ fx%context = NULL_CONTEXT
+ call reset_elstack(fx%element_stack)
+ fx%action = ""
+ fx%root_element_seen = .false.
+ call reset_buffer(fx%buffer)
+ call reset_buffer(fx%element_name)
+ call reset_buffer(fx%pcdata)
+ call reset_buffer(fx%root_element_name)
+ call reset_dict(fx%attributes)
+end subroutine reset_fsm
+
+!------------------------------------------------------------
+subroutine evolve_fsm(fx,c,signal)
+!
+! Finite-state machine evolution rules for XML parsing.
+!
+type(fsm_t), intent(inout)      :: fx    ! Internal state
+character(len=1), intent(in)    :: c
+integer, intent(out)            :: signal
+
+!
+! Reset signal
+!
+signal = QUIET
+!
+
+if (.not. (c .in. valid_chars)) then
+!
+!      Let it pass (in case the underlying encoding is UTF-8)
+!      But this chars in a name will cause havoc
+!
+!      signal = EXCEPTION
+!      fx%state = ERROR
+!      fx%action = trim("Not a valid character in simple encoding: "//c)
+!      RETURN
+endif
+
+select case(fx%state)
+
+ case (INIT)
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without being in one!")
+      else
+         if (fx%debug) fx%action = ("Reading garbage chars")
+      endif
+
+ case (START_TAG_MARKER)
+      if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Tag empty!")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Double opening of tag!!")
+      else if (c == "/") then
+         fx%state = CLOSINGTAG_MARKER
+         if (fx%debug) fx%action = ("Starting endtag: ")
+         fx%context = CLOSING_TAG
+      else if (c == "?") then
+         fx%state = START_XML_DECLARATION
+         if (fx%debug) fx%action = ("Starting XML declaration ")
+         fx%context = XML_DECLARATION_TAG
+      else if (c == "!") then
+         fx%state = BANG
+         if (fx%debug) fx%action = ("Saw ! -- comment or SGML declaration expected...")
+      else if (c .in. whitespace) then
+         fx%state = ERROR
+         fx%action = ("Cannot have whitespace after <")
+      else if (c .in. initial_name_chars) then
+         fx%context = OPENING_TAG
+         fx%state = IN_NAME
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Starting to read name in tag")
+      else 
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for name")
+      endif
+
+
+ case (BANG)
+      if (c == "-") then
+         fx%state = BANG_HYPHEN
+         if (fx%debug) fx%action = ("Almost ready to start comment ")
+      else if (c .in. uppercase_chars) then
+         fx%state = IN_SGML_DECLARATION
+         fx%nlts = 0
+         fx%nbrackets = 0
+         if (fx%debug) fx%action = ("SGML declaration ")
+         fx%context = SGML_DECLARATION_TAG
+         call add_to_buffer(c,fx%buffer)
+      else if (c == "[") then
+         fx%state = CDATA_PREAMBLE
+         if (fx%debug) fx%action = ("Declaration with [ ")
+         fx%context = CDATA_SECTION_TAG
+      else
+         fx%state = ERROR
+         fx%action = ("Wrong character after ! ")
+      endif
+
+ case (CDATA_PREAMBLE)
+      ! We assume a CDATA[ is forthcoming, we do not check
+      if (c == "[") then
+         fx%state = IN_CDATA_SECTION
+         if (fx%debug) fx%action = ("About to start reading CDATA contents")
+      else if (c == "]") then
+         fx%state = ERROR
+         fx%action = ("Unexpected ] in CDATA preamble")
+      else
+         if (fx%debug) fx%action = ("Reading CDATA preamble")
+      endif
+
+ case (IN_CDATA_SECTION)
+      if (c == "]") then
+         fx%state = ONE_BRACKET
+         if (fx%debug) fx%action = ("Saw a ] in CDATA section")
+      else
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading contents of CDATA section")
+      endif
+
+ case (ONE_BRACKET)
+      if (c == "]") then
+         fx%state = TWO_BRACKET
+         if (fx%debug) fx%action = ("Maybe finish a CDATA section")
+      else
+         fx%state = IN_CDATA_SECTION
+         call add_to_buffer("]",fx%buffer)
+         if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+      endif
+
+ case (TWO_BRACKET)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal = END_OF_TAG
+         if (fx%debug) fx%action = ("End of CDATA section")
+         fx%pcdata = fx%buffer    ! Not quite the same behavior
+                                  ! as pcdata... (not filtered)
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_CDATA_SECTION
+         call add_to_buffer("]",fx%buffer)
+         if (fx%debug) fx%action = ("Continue reading contents of CDATA section")
+      endif
+
+ case (IN_SGML_DECLARATION)
+      if (c == "<") then
+         fx%nlts = fx%nlts + 1
+         call add_to_buffer("<",fx%buffer)
+         fx%action = "Read an intermediate < in SGML declaration"
+      else if (c == "[") then
+         fx%nbrackets = fx%nbrackets + 1
+         call add_to_buffer("[",fx%buffer)
+         fx%action = "Read a [ in SGML declaration"
+      else if (c == "]") then
+         fx%nbrackets = fx%nbrackets - 1
+         call add_to_buffer("]",fx%buffer)
+         fx%action = "Read a ] in SGML declaration"
+      else if (c == ">") then
+         if (fx%nlts == 0) then
+            if (fx%nbrackets == 0) then
+               fx%state = END_TAG_MARKER
+               signal  = END_OF_TAG
+               if (fx%debug) fx%action = ("Ending SGML declaration tag")
+               fx%pcdata = fx%buffer       ! Same behavior as pcdata
+               call reset_buffer(fx%buffer)
+            else
+               fx%state = ERROR
+               fx%action = ("Unmatched ] in SGML declaration")
+            endif
+         else
+            fx%nlts = fx%nlts -1
+            call add_to_buffer(">",fx%buffer)
+            fx%action = "Read an intermediate > in SGML declaration"
+         endif
+      else
+         if (fx%debug) fx%action = ("Keep reading SGML declaration")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (BANG_HYPHEN)
+      if (c == "-") then
+         fx%state = IN_COMMENT
+         fx%context = COMMENT_TAG
+         if (fx%debug) fx%action = ("In comment ")
+      else
+         fx%state = ERROR
+         fx%action = ("Wrong character after <!- ")
+      endif
+
+ case (START_XML_DECLARATION)
+      if (c .in. initial_name_chars) then
+         fx%state = IN_NAME
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Starting to read name in XML declaration")
+      else
+         fx%state = ERROR
+         fx%action = "Wrong character after ? in start of XML declaration"
+      endif
+
+ case (CLOSINGTAG_MARKER)
+      if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Closing tag empty!")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Double opening of closing tag!!")
+      else if (c == "/") then
+         fx%state = ERROR
+         fx%action = ("Syntax error (<//)")
+      else if (c .in. whitespace) then
+         fx%state = ERROR
+         fx%action = ("Cannot have whitespace after </")
+      else if (c .in. initial_name_chars) then
+         fx%state = IN_NAME
+         if (fx%debug) fx%action = ("Starting to read name inside endtag")
+         call add_to_buffer(c,fx%buffer)
+      else 
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for name")
+      endif
+
+ case (IN_NAME)
+      if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("Ending tag")
+!         call set_element_name(fx%buffer,fx%element)
+         fx%element_name = fx%buffer
+         call reset_buffer(fx%buffer)
+         call reset_dict(fx%attributes)
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("Almost ending single tag")
+!            call set_element_name(fx%buffer,fx%element)
+            fx%element_name = fx%buffer
+            call reset_buffer(fx%buffer)
+            call reset_dict(fx%attributes)
+         endif
+      else if (c .in. whitespace) then
+         fx%state = WHITESPACE_IN_TAG
+         if (fx%debug) fx%action = ("Ending name chars")
+!            call set_element_name(fx%buffer,fx%element)
+         fx%element_name = fx%buffer
+         call reset_buffer(fx%buffer)
+         call reset_dict(fx%attributes)
+      else if (c .in. name_chars) then
+         if (fx%debug) fx%action = ("Reading name chars in tag")
+         call add_to_buffer(c,fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal character for name")
+      endif
+
+ case (IN_ATT_NAME)
+      if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag in the middle of an attribute")
+      else if (c == "/") then
+         fx%state = ERROR
+         fx%action = ("Ending tag in the middle of an attribute")
+      else if (c .in. whitespace) then
+         fx%state = SPACE_BEFORE_EQUAL  
+         if (fx%debug) fx%action = ("Whitespace after attr. name (specs?)")
+         call add_key_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if ( c == "=" ) then
+         fx%state = EQUAL
+         if (fx%debug) fx%action = ("End of attr. name")
+         call add_key_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c .in. name_chars) then
+         if (fx%debug) fx%action = ("Reading attribute name chars")
+         call add_to_buffer(c,fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal character for attribute name")
+      endif
+
+ case (EQUAL)
+      if ( (c == """") .or. (c == "'") ) then
+         fx%state = START_QUOTE
+         if (fx%debug) fx%action = ("Found beginning quote")
+         fx%quote_char = c
+      else if (c .in. whitespace) then
+         fx%state = SPACE_AFTER_EQUAL
+         if (fx%debug) fx%action = ("Whitespace after equal sign...")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use quotes for attribute values")
+      endif
+
+ case (SPACE_BEFORE_EQUAL)
+      if ( c == "=" ) then
+         fx%state = EQUAL
+         if (fx%debug) fx%action = ("Equal sign")
+      else if (c .in. whitespace) then
+         if (fx%debug) fx%action = ("More whitespace before equal sign...")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use equal sign for attribute values")
+      endif
+
+ case (SPACE_AFTER_EQUAL)
+      if ( c == "=" ) then
+         fx%state = ERROR
+         fx%action = ("Duplicate Equal sign")
+      else if (c .in. whitespace) then
+         if (fx%debug) fx%action = ("More whitespace after equal sign...")
+      else  if ( (c == """") .or. (c == "'") ) then
+         fx%state = START_QUOTE
+         fx%quote_char = c
+         if (fx%debug) fx%action = ("Found beginning quote")
+      else
+         fx%state = ERROR
+         fx%action = ("Must use quotes for attribute values")
+      endif
+
+ case (START_QUOTE)
+      if (c == fx%quote_char) then
+         fx%state = END_QUOTE
+         if (fx%debug) fx%action = ("Emtpy attribute value...")
+         call add_value_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Attribute value cannot contain <")
+      else   ! actually allowed chars in att values... Specs: No "<"        
+         fx%state = IN_ATT_VALUE
+         if (fx%debug) fx%action = ("Starting to read attribute value")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (IN_ATT_VALUE)
+      if (c == fx%quote_char) then
+         fx%state = END_QUOTE
+         if (fx%debug) fx%action = ("End of attribute value")
+         call add_value_to_dict(fx%buffer,fx%attributes)
+         call reset_buffer(fx%buffer)
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Attribute value cannot contain <")
+      else if ( (c == char(10)) ) then
+         fx%state = ERROR
+!
+!        Aparently other whitespace is allowed...
+!
+         fx%action = ("No newline allowed in attr. value (specs?)")
+      else        ! all other chars allowed in attr value
+         if (fx%debug) fx%action = ("Reading attribute value chars")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (END_QUOTE)
+      if ((c == """") .or. (c == "'")) then
+         fx%state = ERROR
+         fx%action = ("Duplicate end quote")
+      else if (c .in. whitespace) then
+         fx%state = WHITESPACE_IN_TAG
+         if (fx%debug) fx%action = ("Space in between attributes or to end of tag")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         if (fx%context == XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "End of XML declaration without ?"
+         else
+            fx%state = END_TAG_MARKER
+            signal  = END_OF_TAG
+            if (fx%debug) fx%action = ("Ending tag after some attributes")
+         endif
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("Almost ending single tag after some attributes")
+         endif
+      else if (c == "?") then
+         if (fx%context /= XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "Wrong lone ? in tag"
+         else
+            fx%state = QUESTION_MARK
+            if (fx%debug) fx%action = ("About to end XML declaration")
+         endif
+      else   
+         fx%state = ERROR
+         fx%action = ("Must have some whitespace after att. value")
+      endif
+
+
+ case (WHITESPACE_IN_TAG)
+      if ( c .in. whitespace) then
+         if (fx%debug) fx%action = ("Reading whitespace in tag")
+      else if (c == "<") then
+         fx%state = ERROR
+         fx%action = ("Starting tag within tag")
+      else if (c == ">") then
+         if (fx%context == XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "End of XML declaration without ?"
+         else
+            fx%state = END_TAG_MARKER
+            signal  = END_OF_TAG
+            if (fx%debug) fx%action = ("End whitespace in tag")
+         endif
+      else if (c == "/") then
+         if (fx%context /= OPENING_TAG) then
+            fx%state = ERROR
+            fx%action = ("Single tag did not open as start tag")
+         else 
+            fx%state = SINGLETAG_MARKER
+            fx%context = SINGLE_TAG
+            if (fx%debug) fx%action = ("End whitespace in single tag")
+         endif
+      else if (c .in. initial_name_chars) then
+         fx%state = IN_ATT_NAME
+         if (fx%debug) fx%action = ("Starting Attribute name in tag")
+         call add_to_buffer(c,fx%buffer)
+      else if (c == "?") then
+         if (fx%context /= XML_DECLARATION_TAG) then
+            fx%state = ERROR
+            fx%action = "Wrong lone ? in tag"
+         else
+            fx%state = QUESTION_MARK
+            if (fx%debug) fx%action = ("About to end XML declaration after whitespace")
+         endif
+      else
+         fx%state = ERROR
+         fx%action = ("Illegal initial character for attribute")
+      endif
+
+ case (QUESTION_MARK)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("End of XML declaration tag")
+      else
+         fx%state = ERROR
+         fx%action = "No > after ? in XML declaration tag"
+      endif
+
+ case (IN_COMMENT)
+      !
+      ! End of comment is  "-->", and  ">" can appear inside comments
+      !
+      if (c == "-") then
+         fx%state = ONE_HYPHEN
+         if (fx%debug) fx%action = ("Saw - in Comment")
+      else
+         if (fx%debug) fx%action = ("Reading comment")
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (ONE_HYPHEN)
+      if (c == "-") then
+         fx%state = TWO_HYPHEN
+         if (fx%debug) fx%action = ("About to end comment")
+      else
+         fx%state = IN_COMMENT
+         if (fx%debug) fx%action = ("Keep reading comment after -: ")
+         call add_to_buffer("-",fx%buffer)
+         call add_to_buffer(c,fx%buffer)
+      endif
+
+ case (TWO_HYPHEN)
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("End of Comment")
+         fx%pcdata = fx%buffer                  ! Same behavior as pcdata
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = ERROR
+         fx%action = ("Cannot have -- in comment")
+      endif
+
+ case (SINGLETAG_MARKER)
+
+      if (c == ">") then
+         fx%state = END_TAG_MARKER
+         signal  = END_OF_TAG
+         if (fx%debug) fx%action = ("Ending tag")
+         ! We have to call begin_element AND end_element
+      else 
+         fx%state = ERROR
+         fx%action = ("Wrong ending of single tag")
+      endif
+
+ case (IN_PCDATA)
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("End of pcdata -- Starting tag")
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without starting it!")
+      else if  (c == char(10)) then
+         fx%state = IN_PCDATA_AT_EOL
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("Resetting PCDATA buffer at newline")
+         call add_to_buffer(c,fx%buffer)
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading chars outside tags")
+         !
+         ! Check whether we are close to the end of the buffer. 
+         ! If so, make a chunk and reset the buffer
+         if (c .in. whitespace) then
+            if (buffer_nearly_full(fx%buffer)) then
+               signal = CHUNK_OF_PCDATA
+               if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+               fx%pcdata = fx%buffer
+               call reset_buffer(fx%buffer)
+            endif
+         endif
+      endif
+
+ case (IN_PCDATA_AT_EOL)
+      !
+      ! Avoid triggering an extra pcdata event
+      !
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("No more pcdata after eol-- Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Ending tag without starting it!")
+      else if  (c == char(10)) then
+         fx%state = IN_PCDATA_AT_EOL
+         signal = CHUNK_OF_PCDATA
+         if (fx%debug) fx%action = ("Resetting PCDATA buffer at repeated newline")
+         call add_to_buffer(c,fx%buffer)
+         fx%pcdata = fx%buffer
+         call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_PCDATA
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("Reading chars outside tags")
+         !
+         ! Check whether we are close to the end of the buffer. 
+         ! If so, make a chunk and reset the buffer
+         if (c .in. whitespace) then
+            if (buffer_nearly_full(fx%buffer)) then
+               signal = CHUNK_OF_PCDATA
+               if (fx%debug) fx%action = ("Resetting almost full PCDATA buffer")
+               fx%pcdata = fx%buffer
+               call reset_buffer(fx%buffer)
+            endif
+         endif
+      endif
+
+
+
+ case (END_TAG_MARKER)
+!
+      if (c == "<") then
+         fx%state = START_TAG_MARKER
+         if (fx%debug) fx%action = ("Starting tag")
+      else if (c == ">") then
+         fx%state = ERROR
+         fx%action = ("Double ending of tag!")
+!
+!     We should make this whitespace in general (maybe not?
+!     how about indentation in text chunks?)
+!     See specs.
+!
+      else if (c == char(10)) then
+        ! Ignoring LF after end of tag is probably non standard...
+
+         if (fx%debug) &
+            fx%action = ("---------Discarding newline after end of tag")
+
+        !!!  New code for full compliance
+        ! fx%state = IN_PCDATA_AT_EOL
+        ! call add_to_buffer(c,fx%buffer)
+        ! if (fx%debug) &
+        !    fx%action = ("Found LF after end of tag. Emitting PCDATA event")
+        ! signal = CHUNK_OF_PCDATA
+        ! fx%pcdata = fx%buffer
+        ! call reset_buffer(fx%buffer)
+      else
+         fx%state = IN_PCDATA
+         call add_to_buffer(c,fx%buffer)
+         if (fx%debug) fx%action = ("End of Tag. Starting to read PCDATA")
+      endif
+
+ case (ERROR)
+
+      stop "Cannot continue after parsing errors!"
+
+ end select
+
+if (fx%state == ERROR) signal  = EXCEPTION
+
+end subroutine evolve_fsm
+
+end module m_fsm
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_io.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_io.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_io.f90	(revision 2354)
@@ -0,0 +1,94 @@
+module m_io
+
+!
+! Basic  I/O tools
+!
+integer, public, save            :: io_eor, io_eof
+
+public  :: get_unit, setup_io
+private :: find_eor_eof
+
+CONTAINS
+
+! ----------------------------------------------------------------------
+subroutine setup_io()
+  call find_eor_eof(io_eor, io_eof)
+end subroutine setup_io
+
+! ----------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out)  :: lun
+integer, intent(out)  :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+   lun = i
+   inquire(unit=lun,opened=unit_used)
+   if (.not. unit_used) then
+      iostat = 0
+      return
+   endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+! ----------------------------------------------------------------------
+
+subroutine find_eor_eof(io_eor,io_eof)
+!
+! Determines the values of the iostat values for End of File and 
+! End of Record (in non-advancing I/O)
+!
+integer, intent(out)           :: io_eor
+integer, intent(out)           :: io_eof
+
+integer           :: lun, iostat
+character(len=1)  :: c
+
+call get_unit(lun,iostat)
+
+if (iostat /= 0) stop "Out of unit numbers"
+
+open(unit=lun,status="scratch",form="formatted", &
+     action="readwrite",position="rewind",iostat=iostat)
+if (iostat /= 0)   stop "Cannot open test file"
+
+write(unit=lun,fmt=*)  "a"
+write(unit=lun,fmt=*)  "b"
+
+rewind(unit=lun)
+
+io_eor = 0
+do
+  read(unit=lun,fmt="(a1)",advance="NO",iostat=io_eor) c
+  if (io_eor /= 0) exit
+enddo
+
+io_eof = 0
+do
+  read(unit=lun,fmt=*,iostat=io_eof)
+  if (io_eof /= 0) exit
+enddo
+
+!!!!!!!!print *, "IO_EOR, IO_EOF: ", io_eor, io_eof
+
+close(unit=lun,status="delete")
+
+end subroutine find_eor_eof
+
+! ----------------------------------------------------------------------
+end module m_io
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_reader.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_reader.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_reader.f90	(revision 2354)
@@ -0,0 +1,298 @@
+module m_reader
+
+use m_io
+
+private
+
+integer, parameter, public              :: BUFFER_NOT_CONNECTED = -2048
+integer, private, parameter             :: MAXLENGTH = 1024
+
+type, public :: file_buffer_t
+private
+      logical                           :: connected
+      logical                           :: eof
+      integer                           :: lun
+      character(len=50)                 :: filename
+      integer                           :: counter
+      character(len=MAXLENGTH)          :: buffer
+      integer                           :: line
+      integer                           :: col
+      integer                           :: pos 
+      integer                           :: nchars
+      logical                           :: debug
+end type file_buffer_t
+
+public  :: get_character, sync_file
+public  :: line, column, nchars_processed
+public  :: open_file, close_file_buffer, rewind_file, mark_eof_file
+public  :: eof_file
+
+private :: fill_buffer
+
+CONTAINS
+
+!-----------------------------------------
+!
+subroutine open_file(fname,fb,iostat,record_size,verbose)
+character(len=*), intent(in)      :: fname
+type(file_buffer_t), intent(out)  :: fb
+integer, intent(out)              :: iostat
+integer, intent(in), optional     :: record_size
+logical, intent(in), optional     :: verbose
+
+iostat = 0
+
+call setup_io()
+
+fb%connected = .false.
+
+call get_unit(fb%lun,iostat)
+if (iostat /= 0) then
+   if (fb%debug) print *, "Cannot get unit"
+   return
+endif
+
+if (present(verbose)) then
+   fb%debug = verbose
+else
+   fb%debug = .false.
+endif
+
+if (present(record_size)) then
+   open(unit=fb%lun,file=fname,form="formatted",status="old", &
+        action="read",position="rewind",recl=record_size,iostat=iostat)
+else
+   open(unit=fb%lun,file=fname,form="formatted",status="old", &
+        action="read",position="rewind",recl=65536,iostat=iostat)
+endif
+if (iostat /= 0) then
+   if (fb%debug) print *, "Cannot open file ", trim(fname), " iostat: ", iostat
+   return
+endif
+
+fb%connected = .true.
+fb%counter = 0
+fb%eof = .false.
+fb%line = 1
+fb%col = 0
+fb%filename = fname
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+end subroutine open_file
+
+!-------------------------------------------------
+subroutine rewind_file(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+fb%eof = .false.
+fb%counter = 0
+fb%line = 1
+fb%col = 0
+fb%pos = 0
+fb%nchars = 0
+fb%buffer = ""
+
+rewind(unit=fb%lun)
+
+end subroutine rewind_file
+!-----------------------------------------
+subroutine mark_eof_file(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+fb%eof = .true.
+
+end subroutine mark_eof_file
+
+!-----------------------------------------
+subroutine close_file_buffer(fb)
+type(file_buffer_t), intent(inout)  :: fb
+
+if (fb%connected) then
+    close(unit=fb%lun)
+    fb%connected = .false.
+endif
+
+end subroutine close_file_buffer
+
+!-------------------------------------------------
+function eof_file(fb) result (res)
+type(file_buffer_t), intent(in)  :: fb
+logical                          :: res
+
+res = fb%eof
+
+end function eof_file
+!-----------------------------------------
+!-----------------------------------------
+! New version, able to cope with arbitrarily long lines 
+! (still need to specify a big enough record_size if necessary)
+!
+subroutine fill_buffer(fb,iostat)
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)  :: iostat
+! 
+!
+character(len=41)  :: str       ! 40 seems like a good compromise?
+                                ! (1 extra for added newline, see below)
+integer            :: len
+!
+read(unit=fb%lun,iostat=iostat,advance="no",size=len,fmt="(a40)") str
+
+if (iostat == io_eof) then
+   
+   ! End of file
+   if (fb%debug) print *, "End of file."
+   return
+
+else if (iostat > 0) then
+
+   ! Hard i/o error
+   if (fb%debug) print *, "Hard i/o error. iostat:", iostat
+   RETURN
+
+else
+!
+ if (fb%debug) then
+   print *, "Buffer: len, iostat", len, iostat
+   print *, trim(str)
+ endif
+
+   fb%pos = 0
+
+   if (iostat == 0) then
+
+      !  Normal read, with more stuff left on the line
+      !
+      fb%buffer = str(1:len) 
+      fb%nchars = len
+
+   else         ! (end of record)
+      !
+      !  End of record. We mark it with an LF, whatever it is the native marker.
+      !
+!!      fb%buffer = str(1:len) // char(10)
+      fb%buffer = str(1:len)             !! Avoid allocation of string
+      len = len + 1                      !! by compiler
+      fb%buffer(len:len) = char(10)   
+      fb%nchars = len
+      iostat = 0
+   endif
+
+endif
+
+end subroutine fill_buffer
+
+!---------------------------------------------------------------
+subroutine get_character(fb,c,iostat)
+character(len=1), intent(out) :: c
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)          :: iostat
+
+character(len=1)   :: c_next
+
+if (.not. fb%connected) then
+      iostat = BUFFER_NOT_CONNECTED
+      return
+endif
+
+if (fb%pos >= fb%nchars) then
+      call fill_buffer(fb,iostat)
+      if (iostat /= 0) return
+endif
+fb%pos = fb%pos + 1
+c = fb%buffer(fb%pos:fb%pos)
+fb%counter = fb%counter + 1              ! Raw counter
+fb%col = fb%col + 1
+!
+! Deal with end-of-line handling on the processor...
+!
+if (c == char(10)) then
+   ! Our own marker for end of line
+   fb%line = fb%line + 1
+   fb%col = 0
+endif
+if (c == char(13)) then
+   c_next = fb%buffer(fb%pos+1:fb%pos+1)
+   if (c_next == char(10)) then
+      !
+      ! Found CRLF. We replace it by LF, as per specs.
+      c = c_next
+      fb%pos = fb%pos + 1
+      if (fb%debug) print *, "-/-> Removed CR before LF in get_character"
+   else
+      ! Replace single CR by LF
+      c = char(10)
+      if (fb%debug) print *, "-/-> Changed CR to LF in get_character -- line++"
+      !
+   endif
+   ! In both cases we increase the line counter and reset the column
+   !
+   fb%line = fb%line + 1
+   fb%col = 0
+endif
+
+iostat = 0
+
+end subroutine get_character
+
+!----------------------------------------------------
+!----------------------------------------------------
+! Error Location functions
+!
+function line(fb) result (ll)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: ll
+
+ll = fb%line
+end function line
+
+!----------------------------------------------------
+function column(fb) result (col)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: col
+
+col = fb%col
+end function column
+!----------------------------------------------------
+!----------------------------------------------------
+function nchars_processed(fb) result (nc)
+type(file_buffer_t), intent(in)  :: fb
+integer                          :: nc
+
+nc = fb%counter
+end function nchars_processed
+!----------------------------------------------------
+
+subroutine sync_file(fb,iostat)
+type(file_buffer_t), intent(inout)  :: fb
+integer, intent(out)                :: iostat
+!
+! Repositions the file so that it matches with
+! the stored file_buffer information
+!
+integer          :: target_counter
+character(len=1) :: c
+
+target_counter = fb%counter
+call rewind_file(fb)
+iostat = 0
+do
+   if (fb%counter == target_counter) exit
+   call get_character(fb,c,iostat)
+   if (iostat /= 0) return
+enddo
+
+end subroutine sync_file
+
+end module m_reader
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_xml_error.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_xml_error.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_xml_error.f90	(revision 2354)
@@ -0,0 +1,84 @@
+module m_xml_error
+!
+! Error handling
+!
+use m_elstack
+private
+
+type, public  :: xml_error_t
+      character(len=100)  :: message
+      integer             :: line
+      integer             :: column
+      type(elstack_t)     :: stack
+      integer             :: severity
+end type xml_error_t
+
+integer, public             ::  xml_stderr = 0    ! Unit for error info
+integer, public, parameter  ::  SEVERE_ERROR_CODE=0, WARNING_CODE=1
+
+public  :: build_error_info, default_error_handler
+public  :: set_xml_stderr
+
+CONTAINS
+
+!-------------------------------------------------------------------------
+subroutine build_error_info(error_info,message,line,column,stack,severity)
+type(xml_error_t), intent(out)        :: error_info
+integer, intent(in)                   :: line, column
+character(len=*), intent(in)          :: message
+type(elstack_t), intent(in)           :: stack
+integer, intent(in)                   :: severity
+
+error_info%message = message
+error_info%line = line
+error_info%column = column
+error_info%stack = stack
+error_info%severity = severity
+
+end subroutine build_error_info
+
+!--------------------------------------------------
+
+subroutine default_error_handler(error_info)
+type(xml_error_t), intent(in)            :: error_info
+!
+! Default error handling
+!
+if (error_info%severity == SEVERE_ERROR_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Error:"
+else if (error_info%severity == WARNING_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** XML parsing Warning:"
+endif
+write(unit=xml_stderr,fmt="(a)") trim(error_info%message)
+write(unit=xml_stderr,fmt="(a,i8,a,i4)") "Line: ", &
+                                         error_info%line, &
+                                         " Column: ", &
+                                         error_info%column
+write(unit=xml_stderr,fmt="(a)") "Element traceback:"
+call print_elstack(error_info%stack,unit=xml_stderr)
+!
+!   If there is a severe error the program should stop...
+!
+if (error_info%severity == SEVERE_ERROR_CODE)  then
+      STOP
+else if (error_info%severity == WARNING_CODE)  then
+   write(unit=xml_stderr,fmt="(a)") "*** Continuing after Warning..."
+endif
+
+end subroutine default_error_handler
+
+!-------------------------------------------------------------------------
+subroutine set_xml_stderr(unit)
+integer, intent(in)  :: unit
+
+xml_stderr  = unit
+
+end subroutine set_xml_stderr
+
+end module m_xml_error
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/sax/m_xml_parser.f90
===================================================================
--- /OBSOLETE/XMLF90/src/sax/m_xml_parser.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/sax/m_xml_parser.f90	(revision 2354)
@@ -0,0 +1,506 @@
+module m_xml_parser
+
+!
+! Basic module to parse XML in the SAX spirit.
+!
+
+use m_buffer
+use m_reader
+use m_fsm
+use m_dictionary
+use m_debug
+use m_xml_error
+use m_elstack          ! For element nesting checks
+use m_entities
+!
+private
+
+!
+!  XML file handle
+!
+type, public :: xml_t
+private
+      type(file_buffer_t)  :: fb
+      type(fsm_t)          :: fx
+      character(len=200)   :: path_mark
+end type xml_t
+
+!
+public :: xml_parse
+public :: open_xmlfile, close_xmlfile
+public :: endfile_xmlfile, rewind_xmlfile
+public :: eof_xmlfile, sync_xmlfile
+public :: xml_char_count
+public :: xml_path, xml_mark_path, xml_get_path_mark
+public :: xml_name, xml_attributes
+
+CONTAINS  !=============================================================
+
+subroutine open_xmlfile(fname,fxml,iostat,record_size)
+character(len=*), intent(in)      :: fname
+integer, intent(out)              :: iostat
+type(xml_t), intent(out)          :: fxml
+integer, intent(in), optional     :: record_size
+
+call open_file(fname,fxml%fb,iostat,record_size)
+call init_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine open_xmlfile
+!-------------------------------------------------------------------------
+
+subroutine rewind_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call rewind_file(fxml%fb)
+call reset_fsm(fxml%fx)
+fxml%path_mark = ""
+
+end subroutine rewind_xmlfile
+
+!-----------------------------------------
+subroutine endfile_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call mark_eof_file(fxml%fb) 
+
+end subroutine endfile_xmlfile
+
+!-----------------------------------------
+subroutine close_xmlfile(fxml)
+type(xml_t), intent(inout) :: fxml
+
+call close_file_buffer(fxml%fb)
+call reset_fsm(fxml%fx)         ! just in case
+fxml%path_mark = ""             ! ""
+
+end subroutine close_xmlfile
+
+!-----------------------------------------
+subroutine sync_xmlfile(fxml,iostat)
+type(xml_t), intent(inout) :: fxml
+integer, intent(out)       :: iostat
+
+call sync_file(fxml%fb,iostat)
+! Do not reset fx: that's the whole point of synching.
+
+end subroutine sync_xmlfile
+
+!----------------------------------------------------
+function eof_xmlfile(fxml) result (res)
+type(xml_t), intent(in)          :: fxml
+logical                          :: res
+
+res = eof_file(fxml%fb)
+
+end function eof_xmlfile
+!
+!----------------------------------------------------
+!----------------------------------------------------
+function xml_char_count(fxml) result (nc)
+type(xml_t), intent(in)          :: fxml
+integer                          :: nc
+
+nc = nchars_processed(fxml%fb)
+
+end function xml_char_count
+!
+!----------------------------------------------------
+!
+
+subroutine xml_parse(fxml, begin_element_handler,    &
+                           end_element_handler,      &
+                           pcdata_chunk_handler,     &
+                           comment_handler,          &
+                           xml_declaration_handler,  &
+                           cdata_section_handler,     &
+                           sgml_declaration_handler, &
+                           error_handler,            &
+                           signal_handler,            &
+                           verbose,                  &
+                           empty_element_handler)
+
+type(xml_t), intent(inout), target  :: fxml
+
+optional                            :: begin_element_handler
+optional                            :: end_element_handler
+optional                            :: pcdata_chunk_handler
+optional                            :: comment_handler
+optional                            :: xml_declaration_handler
+optional                            :: sgml_declaration_handler
+optional                            :: cdata_section_handler
+optional                            :: error_handler
+optional                            :: signal_handler
+logical, intent(in), optional       :: verbose
+optional                            :: empty_element_handler
+
+interface
+   subroutine begin_element_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine begin_element_handler
+
+   subroutine end_element_handler(name)
+   character(len=*), intent(in)     :: name
+   end subroutine end_element_handler
+
+   subroutine pcdata_chunk_handler(chunk)
+   character(len=*), intent(in) :: chunk
+   end subroutine pcdata_chunk_handler
+
+   subroutine comment_handler(comment)
+   character(len=*), intent(in) :: comment
+   end subroutine comment_handler
+
+   subroutine xml_declaration_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine xml_declaration_handler
+
+   subroutine sgml_declaration_handler(sgml_declaration)
+   character(len=*), intent(in) :: sgml_declaration
+   end subroutine sgml_declaration_handler
+
+   subroutine cdata_section_handler(cdata)
+   character(len=*), intent(in) :: cdata
+   end subroutine cdata_section_handler
+
+   subroutine error_handler(error_info)
+   use m_xml_error
+   type(xml_error_t), intent(in)            :: error_info
+   end subroutine error_handler
+
+   subroutine signal_handler(code)
+   logical, intent(out) :: code
+   end subroutine signal_handler
+
+   subroutine empty_element_handler(name,attributes)
+   use m_dictionary
+   character(len=*), intent(in)     :: name
+   type(dictionary_t), intent(in)   :: attributes
+   end subroutine empty_element_handler
+
+end interface
+
+character(len=1)     :: c
+integer              :: iostat, status
+
+character(len=150)   :: message
+integer              :: signal
+
+type(buffer_t)       :: translated_pcdata
+type(buffer_t)       :: name, oldname, dummy
+
+logical              :: have_begin_handler, have_end_handler, &
+                        have_pcdata_handler, have_comment_handler, &
+                        have_xml_declaration_handler, &
+                        have_sgml_declaration_handler, &
+                        have_cdata_section_handler, have_empty_handler, &
+                        have_error_handler, have_signal_handler
+
+logical              :: pause_signal
+
+type(xml_error_t)            :: error_info
+type(file_buffer_t), pointer :: fb
+type(fsm_t), pointer         :: fx
+
+have_begin_handler = present(begin_element_handler)
+have_end_handler = present(end_element_handler)
+have_pcdata_handler = present(pcdata_chunk_handler)
+have_comment_handler = present(comment_handler)
+have_xml_declaration_handler = present(xml_declaration_handler)
+have_sgml_declaration_handler = present(sgml_declaration_handler)
+have_cdata_section_handler = present(cdata_section_handler)
+have_error_handler = present(error_handler)
+have_signal_handler = present(signal_handler)
+have_empty_handler = present(empty_element_handler)
+
+fb => fxml%fb
+fx => fxml%fx
+if (present(verbose)) then
+   debug = verbose                 ! For m_converters
+   fx%debug = verbose              ! job-specific flag
+endif
+
+if (fx%debug) print *, " Entering xml_parse..."
+
+!---------------------------------------------------------------------
+do
+      call get_character(fb,c,iostat)
+
+      if (iostat /= 0) then          ! End of file...
+         if (.not. is_empty(fx%element_stack)) then
+            call build_error_info(error_info, &
+                 "Early end of file.", &
+                 line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+            if (have_error_handler) then
+               call error_handler(error_info)
+            else
+               call default_error_handler(error_info)
+            endif
+         endif
+         call endfile_xmlfile(fxml)  ! Mark it as eof
+         EXIT
+      endif
+
+      call evolve_fsm(fx,c,signal)
+
+      if (fx%debug) print *, c, " ::: ", trim(fx%action)
+
+      if (signal == END_OF_TAG) then
+         !
+         ! We decide whether we have ended an opening tag or a closing tag
+         !
+         if (fx%context == OPENING_TAG) then
+            name = fx%element_name
+
+            if (fx%debug) print *, "We have found an opening tag"
+            if (fx%root_element_seen) then
+               if (name .equal. fx%root_element_name) then
+                  call build_error_info(error_info, &
+                  "Duplicate root element: " // str(name), &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+               if (is_empty(fx%element_stack)) then
+                  call build_error_info(error_info, &
+                  "Opening tag beyond root context: " // str(name), &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+            else
+               fx%root_element_name = name
+               fx%root_element_seen = .true.
+            endif
+            call push_elstack(name,fx%element_stack)
+            if (have_begin_handler) &
+                call begin_element_handler(str(name),fx%attributes)
+
+         else if (fx%context == CLOSING_TAG) then
+            name = fx%element_name
+         
+            if (fx%debug) print *, "We have found a closing tag"
+            if (is_empty(fx%element_stack)) then
+               call build_error_info(error_info, &
+                  "Nesting error: End tag: " // str(name) //  &
+                  " does not match -- too many end tags", &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else
+               call get_top_elstack(fx%element_stack,oldname)
+               if (oldname .equal. name) then
+                  call pop_elstack(fx%element_stack,oldname)
+                  if (have_end_handler) call end_element_handler(str(name))
+!!                  call pop_elstack(fx%element_stack,oldname)
+               else
+                  call build_error_info(error_info, &
+                       "Nesting error: End tag: " // str(name) //  &
+                       ". Expecting end of : " // str(oldname), &
+                       line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+                  if (have_error_handler) then
+                     call error_handler(error_info)
+                  else
+                     call default_error_handler(error_info)
+                  endif
+               endif
+            endif
+         else if (fx%context == SINGLE_TAG) then
+            name = fx%element_name
+
+            if (fx%debug) print *, "We have found a single (empty) tag: ", &
+                                char(name)
+            !
+            ! Push name on to stack to reveal true xpath
+            !
+            call push_elstack(name,fx%element_stack)
+            if (have_empty_handler) then
+               if (fx%debug) print *, "--> calling empty_element_handler."
+               call empty_element_handler(str(name),fx%attributes)
+               call pop_elstack(fx%element_stack,dummy)
+            else
+               if (have_begin_handler) then
+                  if (fx%debug) print *, "--> calling begin_element_handler..."
+                  call begin_element_handler(str(name),fx%attributes)
+               endif
+               call pop_elstack(fx%element_stack,dummy)
+               if (have_end_handler) then
+                  if (fx%debug) print *, "--> ... and end_element_handler."
+                  call end_element_handler(str(name))
+               endif
+            endif
+!!            call pop_elstack(fx%element_stack,dummy)
+
+         else if (fx%context == CDATA_SECTION_TAG) then
+
+            if (fx%debug) print *, "We found a CDATA section"
+            if (is_empty(fx%element_stack)) then
+               if (fx%debug) print *, &
+                   "... Warning: CDATA section outside element context"
+            else
+               if (have_cdata_section_handler) then
+                  call cdata_section_handler(str(fx%pcdata))
+               else
+                  if (have_pcdata_handler) &
+                   call pcdata_chunk_handler(str(fx%pcdata))
+               endif
+            endif
+
+         else if (fx%context == COMMENT_TAG) then
+
+            if (fx%debug) print *, "We found a comment tag"
+            if (have_comment_handler)  &
+                 call comment_handler(str(fx%pcdata))
+
+         else if (fx%context == SGML_DECLARATION_TAG) then
+
+            if (fx%debug) print *, "We found an sgml declaration"
+            if (have_sgml_declaration_handler)  &
+                      call sgml_declaration_handler(str(fx%pcdata))
+
+         else if (fx%context == XML_DECLARATION_TAG) then
+
+            if (fx%debug) print *, "We found an XML declaration"
+            name = fx%element_name
+            if (have_xml_declaration_handler)  &
+                      call xml_declaration_handler(str(name),fx%attributes)
+
+         else
+
+            ! do nothing
+
+         endif
+
+      else if (signal == CHUNK_OF_PCDATA) then
+
+         if (fx%debug) print *, "We found a chunk of PCDATA"
+         if (is_empty(fx%element_stack)) then
+            if (fx%debug) print *, "... Warning: PCDATA outside element context"
+               ! Just a warning
+               call build_error_info(error_info, &
+                  "PCDATA outside of element context", &
+                  line(fb),column(fb),fx%element_stack,WARNING_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+         else
+            !
+            ! Replace entities by their value
+            !
+            call entity_filter(fx%pcdata,translated_pcdata,status,message)
+            if (status < 0) then
+               call build_error_info(error_info, message, &
+                  line(fb),-status,fx%element_stack,SEVERE_ERROR_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else if (status > 0) then
+               ! Just a warning
+               call build_error_info(error_info, message, &
+                  line(fb),status,fx%element_stack,WARNING_CODE)
+               if (have_error_handler) then
+                  call error_handler(error_info)
+               else
+                  call default_error_handler(error_info)
+               endif
+            else
+               if (have_pcdata_handler) &
+                   call pcdata_chunk_handler(str(translated_pcdata))
+            endif
+         endif
+
+      else if (signal == EXCEPTION) then
+         call build_error_info(error_info, fx%action, &
+                  line(fb),column(fb),fx%element_stack,SEVERE_ERROR_CODE)
+         if (have_error_handler) then
+            call error_handler(error_info)
+         else
+            call default_error_handler(error_info)
+         endif
+      else
+         ! QUIET, do nothing
+      endif
+      if (signal /= QUIET) then
+         if (have_signal_handler) then
+            call signal_handler(pause_signal)
+            if (pause_signal) exit
+         endif
+      endif
+
+enddo
+
+end subroutine xml_parse
+
+!-----------------------------------------
+subroutine xml_path(fxml,path)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out)  :: path
+
+call get_elstack_signature(fxml%fx%element_stack,path)
+
+end subroutine xml_path
+
+!-----------------------------------------
+subroutine xml_mark_path(fxml,path)
+!
+! Marks the current path
+!
+type(xml_t), intent(inout) :: fxml
+character(len=*), intent(out)  :: path
+
+call get_elstack_signature(fxml%fx%element_stack,fxml%path_mark)
+path = fxml%path_mark
+
+end subroutine xml_mark_path
+
+!-----------------------------------------
+subroutine xml_get_path_mark(fxml,path)
+!
+! Returns the currently markd path (or an empty string if there are no marks)
+!
+type(xml_t), intent(in)        :: fxml
+character(len=*), intent(out)  :: path
+
+path = fxml%path_mark
+
+end subroutine xml_get_path_mark
+
+!-----------------------------------------
+subroutine xml_name(fxml,name)
+type(xml_t), intent(in) :: fxml
+character(len=*), intent(out)  :: name
+
+name = char(fxml%fx%element_name)
+
+end subroutine xml_name
+!-----------------------------------------
+subroutine xml_attributes(fxml,attributes)
+type(xml_t), intent(in) :: fxml
+type(dictionary_t), intent(out)  :: attributes
+
+attributes = fxml%fx%attributes
+
+end subroutine xml_attributes
+
+end module m_xml_parser
+
+
+
+
Index: /OBSOLETE/XMLF90/src/strings/m_strings.f90
===================================================================
--- /OBSOLETE/XMLF90/src/strings/m_strings.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/strings/m_strings.f90	(revision 2354)
@@ -0,0 +1,6323 @@
+!*******************************************************************************
+! module STRINGS
+! Mart Rentmeester, Mart.Rentmeester@sci.kun.nl
+! http://nn-online.sci.kun.nl/fortran
+! Version 1.0
+!*******************************************************************************
+
+      module m_strings
+
+      private
+
+      type string
+          private
+          integer                 :: len = 0
+          integer                 :: size = 0
+
+          character, pointer      :: chars(:) => null()
+
+      end type string
+
+      character, parameter :: blank = ' '
+
+!     GENERIC PROCEDURE INTERFACE DEFINITIONS
+
+!---- LEN interface
+      interface len
+          module procedure len_s
+      end interface
+
+!---- Conversion (to CHAR) procedure interfaces
+      interface char
+          module procedure s_to_c, &! string to character
+                           s_to_slc       ! string to specified length character
+      end interface
+
+!---- ASSIGNMENT interfaces
+      interface assignment(=)
+          module procedure assign_s_to_s, &! string = string
+                           assign_s_to_c, &! character = string
+                           assign_c_to_s        ! string = character
+      end interface
+
+!---- // operator interfaces
+      interface operator(//)
+          module procedure s_concat_s, &! string // string
+                           s_concat_c, &! string // character
+                           c_concat_s     ! character // string
+      end interface
+
+!---- INSERT_IN_STRING interface
+      interface insert_in_string
+          module procedure insert_in_string_c, insert_in_string_s
+      end interface
+
+!---- PREPEND_TO_STRING interface
+      interface prepend_to_string
+          module procedure prepend_to_string_c, prepend_to_string_s
+      end interface
+
+!---- APPEND_TO_STRING interface
+      interface append_to_string
+          module procedure append_to_string_c, append_to_string_s
+      end interface
+
+!---- REPLACE_IN_STRING interface
+      interface replace_in_string
+          module procedure replace_in_string_sc_s,   replace_in_string_ss_s,   &
+                           replace_in_string_sc_sf,  replace_in_string_ss_sf,  &
+                           replace_in_string_scc,    replace_in_string_ssc,    &
+                           replace_in_string_scs,    replace_in_string_sss,    &
+                           replace_in_string_scc_f,  replace_in_string_ssc_f,  &
+                           replace_in_string_scs_f,  replace_in_string_sss_f
+      end interface
+
+
+!---- REPEAT interface
+      interface repeat
+          module procedure repeat_s
+      end interface
+
+!---- ==  .eq. comparison operator interfaces
+      interface operator(==)
+          module procedure s_eq_s, &! string == string
+                           s_eq_c, &! string == character
+                           c_eq_s         ! character == string
+      end interface
+
+!---- /=  .ne. comparison operator interfaces
+      interface operator(/=)
+          module procedure s_ne_s, &! string /= string
+                           s_ne_c, &! string /= character
+                           c_ne_s         ! character /= string
+      end interface
+
+!---- <  .lt. comparison operator interfaces
+      interface operator(<)
+          module procedure s_lt_s, &! string < string
+                           s_lt_c, &! string < character
+                           c_lt_s         ! character < string
+      end interface
+
+!---- <=  .le. comparison operator interfaces
+      interface operator(<=)
+          module procedure s_le_s, &! string <= string
+                           s_le_c, &! string <= character
+                           c_le_s         ! character <= string
+      end interface
+
+!---- >=  .ge. comparison operator interfaces
+      interface operator(>=)
+          module procedure s_ge_s, &! string >= string
+                           s_ge_c, &! string >= character
+                           c_ge_s         ! character >= string
+      end interface
+
+!---- >  .gt. comparison operator interfaces
+      interface operator(>)
+          module procedure s_gt_s, &! string > string
+                           s_gt_c, &! string > character
+                           c_gt_s         ! character > string
+      end interface
+
+!---- .aeq. comparison operator interfaces
+      interface operator(.aeq.)
+          module procedure a_eq_a, &! array == array
+                           a_eq_c, &! array == character
+                           c_eq_a         ! character == array
+      end interface
+
+!---- .ane. comparison operator interfaces
+      interface operator(.ane.)
+          module procedure a_ne_a, &! array /= array
+                           a_ne_c, &! array /= character
+                           c_ne_a         ! character /= array
+      end interface
+
+!---- .alt. comparison operator interfaces
+      interface operator(.alt.)
+          module procedure a_lt_a, &! array < array
+                           a_lt_c, &! array < character
+                           c_lt_a         ! character < array
+      end interface
+
+!---- .ale. comparison operator interfaces
+      interface operator(.ale.)
+          module procedure a_le_a, &! array <= array
+                           a_le_c, &! array <= character
+                           c_le_a         ! character <= array
+      end interface
+
+!---- .age. comparison operator interfaces
+      interface operator(.age.)
+          module procedure a_ge_a, &! array >= array
+                           a_ge_c, &! array >= character
+                           c_ge_a         ! character >= array
+      end interface
+
+!---- .agt. comparison operator interfaces
+      interface operator(.agt.)
+          module procedure a_gt_a, &! array > array
+                           a_gt_c, &! array > character
+                           c_gt_a         ! character > array
+      end interface
+
+!---- LLT comparison function interfaces
+      interface llt
+          module procedure s_llt_s, &! llt(string,string)
+                           s_llt_c, &! llt(string,character)
+                           c_llt_s        ! llt(character,string)
+      end interface
+
+!---- LLE comparison function interfaces
+      interface lle
+          module procedure s_lle_s, &! lle(string,string)
+                           s_lle_c, &! lle(string,character)
+                           c_lle_s        ! lle(character,string)
+      end interface
+
+!---- LGE comparison function interfaces
+      interface lge
+          module procedure s_lge_s, &! lge(string,string)
+                           s_lge_c, &! lge(string,character)
+                           c_lge_s        ! lge(character,string)
+      end interface
+
+!---- LGT comparison function interfaces
+      interface lgt
+          module procedure s_lgt_s, &! lgt(string,string)
+                           s_lgt_c, &! lgt(string,character)
+                           c_lgt_s        ! lgt(character,string)
+      end interface
+
+!---- ALLT comparison function interfaces
+      interface allt
+          module procedure a_allt_a, &! allt(array,array)
+                           a_allt_c, &! allt(array,character)
+                           c_allt_a        ! allt(character,array)
+      end interface
+
+!---- ALLE comparison function interfaces
+      interface alle
+          module procedure a_alle_a, &! alle(array,array)
+                           a_alle_c, &! alle(array,character)
+                           c_alle_a        ! alle(character,array)
+      end interface
+
+!---- ALGE comparison function interfaces
+      interface alge
+          module procedure a_alge_a, &! alge(array,array)
+                           a_alge_c, &! alge(array,character)
+                           c_alge_a        ! alge(character,array)
+      end interface
+
+!---- ALGT comparison function interfaces
+      interface algt
+          module procedure a_algt_a, &! algt(array,array)
+                           a_algt_c, &! algt(array,character)
+                           c_algt_a        ! algt(character,array)
+      end interface
+
+!---- INDEX procedure
+      interface index
+          module procedure index_ss, index_sc, index_cs
+      end interface
+
+!---- AINDEX procedure
+      interface aindex
+          module procedure aindex_aa, aindex_ac, aindex_ca
+      end interface
+
+!---- SCAN procedure
+      interface scan
+          module procedure scan_ss, scan_sc, scan_cs
+      end interface
+
+!---- ASCAN procedure
+      interface ascan
+          module procedure ascan_aa, ascan_ac, ascan_ca
+      end interface
+
+!---- VERIFY procedure
+      interface verify
+          module procedure verify_ss, verify_sc, verify_cs
+      end interface
+
+!---- AVERIFY procedure
+      interface averify
+          module procedure averify_aa, averify_ac, averify_ca
+      end interface
+
+!---- TRIM interface
+      interface len_trim
+          module procedure len_trim_s
+      end interface
+
+!---- LEN_TRIM interface
+      interface trim
+          module procedure trim_s
+      end interface
+
+!---- IACHAR interface
+      interface iachar
+          module procedure iachar_s
+      end interface
+
+!---- ICHAR interface
+      interface ichar
+          module procedure ichar_s
+      end interface
+
+!---- ADJUSTL interface
+      interface adjustl
+          module procedure adjustl_s
+      end interface
+
+!---- ADJUSTR interface
+      interface adjustr
+          module procedure adjustr_s
+      end interface
+
+!---- LEN_STRIP interface
+      interface len_strip
+          module procedure len_strip_c, len_strip_s
+      end interface
+
+!---- STRIP interface
+      interface strip
+          module procedure strip_c, strip_s
+      end interface
+
+!---- UPPERCASE interface
+      interface uppercase
+          module procedure uppercase_s, uppercase_c
+      end interface
+
+!---- TO_UPPERCASE interface
+      interface to_uppercase
+          module procedure to_uppercase_s, to_uppercase_c
+      end interface
+
+!---- LOWERCASE interface
+      interface lowercase
+          module procedure lowercase_s, lowercase_c
+      end interface
+
+!---- TO_LOWERCASE interface
+      interface to_lowercase
+          module procedure to_lowercase_s, to_lowercase_c
+      end interface
+
+!---- EXTRACT interface
+      interface extract
+          module procedure extract_s, extract_c
+      end interface
+
+!---- SUBSTRING interface
+      interface substring
+          module procedure extract_s, extract_c
+      end interface
+
+!---- REMOVE interface
+      interface remove
+          module procedure remove_s, remove_c
+      end interface
+
+!---- INSERT interface
+      interface insert
+          module procedure insert_ss, insert_cs, insert_sc, insert_cc
+      end interface
+
+!---- REPLACE interface
+      interface replace
+          module procedure replace_cc_s,   replace_cs_s,   &
+                           replace_sc_s,   replace_ss_s,   &
+                           replace_cc_sf,  replace_cs_sf,  &
+                           replace_sc_sf,  replace_ss_sf,  &
+                           replace_ccc,    replace_csc,    &
+                           replace_ccs,    replace_css,    &
+                           replace_scc,    replace_ssc,    &
+                           replace_scs,    replace_sss,    &
+                           replace_ccc_f,  replace_csc_f,  &
+                           replace_ccs_f,  replace_css_f,  &
+                           replace_scc_f,  replace_ssc_f,  &
+                           replace_scs_f,  replace_sss_f
+      end interface
+
+!---- SORT interface
+      interface sort
+          module procedure sort_c, sort_s
+      end interface
+
+!---- LSORT interface
+      interface lsort
+          module procedure lsort_c, lsort_s
+      end interface
+
+!---- RANK interface
+      interface rank
+          module procedure rank_c, rank_s
+      end interface
+
+!---- LRANK interface
+      interface lrank
+          module procedure lrank_c, lrank_s
+      end interface
+
+
+
+!---- Publically accessible entities
+      public :: string
+      public :: assignment(=),unstring
+      public :: insert,replace,remove,extract,substring
+      public :: repeat,index,scan,verify
+      public :: operator(//)
+      public :: operator(==),operator(/=)
+      public :: operator(<),operator(<=)
+      public :: operator(>),operator(>=)
+      public :: llt,lle,lge,lgt
+      public :: char,len,len_trim,trim,iachar,ichar,adjustl,adjustr
+      public :: lowercase,to_lowercase,uppercase,to_uppercase
+      public :: strip,len_strip
+      public :: sort,rank,lsort,lrank
+
+      public :: resize_string,string_size,swap_strings
+      public :: trim_string,strip_string
+      public :: adjustl_string,adjustr_string
+      public :: insert_in_string,remove_from_string
+      public :: prepend_to_string,append_to_string
+      public :: replace_in_string
+
+
+
+
+      contains
+
+!*******************************************************************************
+!     LEN
+!*******************************************************************************
+
+      elemental function len_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: len_s
+
+
+      len_s = s%len
+
+      end function len_s
+
+!*******************************************************************************
+!     STRING_SIZE
+!*******************************************************************************
+
+      elemental function string_size(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: string_size
+
+
+      string_size = s%size
+
+      end function string_size
+
+!*******************************************************************************
+!     CHAR
+!*******************************************************************************
+!     Returns the characters of string as an automatically sized character
+
+      pure function s_to_c(s)
+
+      implicit none
+      type(string),intent(in)   :: s
+      character(len(s))         :: s_to_c
+
+
+      s_to_c = transfer(s%chars(1:len(s)),s_to_c)
+
+      end function s_to_c
+
+!*******************************************************************************
+!     Returns the character of fixed length, length, containing the characters
+!     of string either padded with blanks or truncated on the right to fit
+
+      pure function s_to_slc(s,length)
+
+      implicit none
+      type(string),intent(in)  :: s
+      integer, intent(in)      :: length
+      character(length)        :: s_to_slc
+      integer                  :: i,lc
+
+
+      lc = min(len(s),length)
+      s_to_slc(1:lc) = transfer(s%chars(1:lc),s_to_slc)
+
+!     Result longer than string: padding needed
+      if (lc < length) s_to_slc(lc+1:length) = blank
+
+      end function s_to_slc
+
+!*******************************************************************************
+! Assign a string value to a string variable overriding default assignement.
+! Reallocates string variable to size of string value and copies characters.
+
+      elemental subroutine assign_s_to_s(var,expr)
+
+      implicit none
+      type(string), intent(out)  :: var
+      type(string), intent(in)   :: expr
+
+
+
+      if (associated(var%chars,expr%chars)) then
+!         Identity assignment: nothing to be done
+          continue
+      else
+          if (associated(var%chars)) deallocate(var%chars)
+
+          var%size = expr%size
+          var%len = expr%len
+!AG
+          if (associated(expr%chars)) then
+             allocate(var%chars(1:var%size))
+             var%chars(1:var%len) = expr%chars(1:var%len)
+          endif
+      endif
+
+
+      end subroutine assign_s_to_s
+
+!*******************************************************************************
+! Assign a string value to a character variable.
+! If the string is longer than the character truncate the string on the right.
+! If the string is shorter the character is blank padded on the right.
+
+      elemental subroutine assign_s_to_c(var,expr)
+
+      implicit none
+      character(*), intent(out)  :: var
+      type(string), intent(in)   :: expr
+      integer                    :: i,lc,ls
+
+
+      lc = len(var);
+      ls = min(len(expr),lc)
+
+      var(1:ls) = transfer(expr%chars(1:ls),var(1:ls))
+
+      do i=ls+1,lc
+          var(i:i) = blank
+      enddo
+
+      end subroutine assign_s_to_c
+
+!*******************************************************************************
+!     Assign a character value to a string variable.
+!     Disassociates the string variable from its current value, allocates new
+!     space to hold the characters and copies them from the character value
+!     into this space.
+
+      elemental subroutine assign_c_to_s(var,expr)
+
+      implicit none
+      type(string), intent(out)  :: var
+      character(*), intent(in)   :: expr
+      integer                    :: i,lc
+
+
+
+      if (associated(var%chars)) deallocate(var%chars)
+
+
+      lc = len(expr)
+      var%len = lc
+      var%size = lc
+      allocate(var%chars(1:lc))
+!!AG: NAG compiler uses temporaries here:
+      var%chars(:) = (/ (expr(i:i), i=1,lc) /)
+
+      endsubroutine assign_c_to_s
+
+!*******************************************************************************
+!     RESIZE_STRING procedure
+!*******************************************************************************
+
+!*** return code
+!*** n < 0  --> deallocate?
+
+!     pure subroutine resize_string(s,newsize,status)
+      pure subroutine resize_string(s,newsize)
+
+      implicit none
+      type(string), intent(inout)     :: s
+      integer, intent(in)             :: newsize
+!     integer, intent(out), optional  :: status
+
+      character, pointer              :: c(:)
+
+      integer                         :: i
+
+
+      if (newsize <= 0) return
+
+
+      if (associated(s%chars)) then
+
+          i = min(newsize,s%len)
+          allocate(c(i))
+          c(:) = s%chars(1:i)
+          deallocate(s%chars)
+
+          s%chars => c
+
+          s%len = i
+          s%size = newsize
+      else
+          s%size = newsize
+          s%len = 0
+          allocate(s%chars(s%size))
+      endif
+
+      end subroutine resize_string
+
+!*******************************************************************************
+!     SWAP_STRINGS
+!*******************************************************************************
+      subroutine swap_strings(s1,s2)
+
+
+      implicit none
+      type(string), intent(inout)  :: s1,s2
+      integer                      :: l,s
+      character, pointer           :: c(:)
+
+
+      l = s1%len
+      s = s1%size
+      c => s1%chars
+      s1%len = s2%len
+      s1%size = s2%size
+      s1%chars => s2%chars
+      s2%len = l
+      s2%size = s
+      s2%chars => c
+
+      end subroutine swap_strings
+
+!*******************************************************************************
+!     TRIM_STRINGSIZE
+!*******************************************************************************
+
+      subroutine trim_stringsize(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+      call resize_string(s,len(s))
+
+      end subroutine trim_stringsize
+
+!*******************************************************************************
+!     TRIM_STRING
+!*******************************************************************************
+
+      subroutine trim_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+      s%len = len_trim(s)
+
+      end subroutine trim_string
+
+!*******************************************************************************
+!    STRIP
+!*******************************************************************************
+
+     pure subroutine strip_string(s)
+
+     implicit none
+     type(string), intent(inout)  :: s
+     integer                      :: i,i1,i2
+
+
+     do i1=1,len(s)
+         if (s%chars(i1) /= blank) exit
+     enddo
+     do i2=len(s),1,-1
+         if (s%chars(i2) /= blank) exit
+     enddo
+     do i=i1,i2
+         s%chars(i-i1+1) = s%chars(i)
+     enddo
+     s%len = i2 - i1 + 1
+
+     end subroutine strip_string
+
+!*******************************************************************************
+!     ADJUSTL_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+      pure subroutine adjustl_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      integer                      :: i,j
+
+
+      do i=1,len(s)
+          if (s%chars(i) /= blank) exit
+      enddo
+      do j=i,len(s)
+          s%chars(j-i:j-i) = s%chars(j)
+      enddo
+      s%chars(j+1:) = blank
+
+      end subroutine adjustl_string
+
+!*******************************************************************************
+!     ADJUSTR_STRING
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+      pure subroutine adjustr_string(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      integer                      :: i,j,l,lt
+
+
+      l = len(s)
+      lt = len_trim(s)
+
+      i = l - lt
+
+      do j=1,lt
+          s%chars(j+i:j+i) = s%chars(j)
+      enddo
+      s%chars(1:i) = blank
+
+
+      end subroutine adjustr_string
+
+!*******************************************************************************
+!     PREPEND_TO_STRING
+!*******************************************************************************
+
+      pure subroutine prepend_to_string_s(s1,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer                      :: i,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          do i=1,ls2
+              ss(i) = s2%chars(i)
+          enddo
+          do i=1,ls1
+              ss(ls2+i) = s1%chars(i)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          do i=ls1,1,-1
+              s1%chars(ls2+i) = s1%chars(i)
+          enddo
+          do i=1,ls2
+              s1%chars(i) = s2%chars(i)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine prepend_to_string_s
+
+!*******************************************************************************
+
+      pure subroutine prepend_to_string_c(s,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer                      :: i,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          do i=1,lc
+              ss(i) = c(i:i)
+          enddo
+          do i=1,ls
+              ss(lc+i) = s%chars(i)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          do i=ls,1,-1
+              s%chars(lc+i) = s%chars(i)
+          enddo
+          do i=1,lc
+              s%chars(i) = c(i:i)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine prepend_to_string_c
+
+!*******************************************************************************
+!     APPEND_TO_STRING
+!*******************************************************************************
+
+      pure subroutine append_to_string_s(s1,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer                      :: i,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          do i=1,ls1
+              ss(i) = s1%chars(i)
+          enddo
+          do i=ls1+1,ls1+ls2
+              ss(i) = s2%chars(i-ls1)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          do i=ls1+1,ls1+ls2
+              s1%chars(i) = s2%chars(i-ls1)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine append_to_string_s
+
+!*******************************************************************************
+
+      pure subroutine append_to_string_c(s,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer                      :: i,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          do i=1,ls
+              ss(i) = s%chars(i)
+          enddo
+          do i=ls+1,ls+lc
+              ss(i) = c(i-ls:i-ls)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          do i=ls+1,ls+lc
+              s%chars(i) = c(i-ls:i-ls)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine append_to_string_c
+
+!*******************************************************************************
+!     INSERT_IN_STRING
+!*******************************************************************************
+
+      pure subroutine insert_in_string_s(s1,start,s2)
+
+      implicit none
+      type(string), intent(inout)  :: s1
+      type(string), intent(in)     :: s2
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,ls1,ls2
+
+      character, pointer           :: ss(:)
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      if (ls2 == 0) return
+      if (ls1+ls2 > string_size(s1)) then
+          allocate(ss(ls1+ls2))
+          is = max(start,1)
+          ip = min(ls1+1,is)
+          do i=1,ip-1
+              ss(i) = s1%chars(i)
+          enddo
+          do i=ip,ip+ls2-1
+              ss(i) = s2%chars(i-ip+1)
+          enddo
+          do i=ip+ls2,ls1+ls2
+              ss(i) = s1%chars(i-ls2)
+          enddo
+          deallocate(s1%chars)
+
+          s1%chars => ss
+
+          s1%len = ls1 + ls2
+          s1%size = s1%len
+      else
+          is = max(start,1)
+          ip = min(ls1+1,is)
+          do i=ls1+ls2,ip+ls2,-1
+              s1%chars(i) = s1%chars(i-ls2)
+          enddo
+          do i=ip,ip+ls2-1
+              s1%chars(i) = s2%chars(i-ip+1)
+          enddo
+          s1%len = ls1 + ls2
+      endif
+
+      end subroutine insert_in_string_s
+
+!*******************************************************************************
+
+      pure subroutine insert_in_string_c(s,start,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,ls,lc
+
+      character, pointer           :: ss(:)
+
+
+
+      ls = len(s)
+      lc = len(c)
+      if (lc == 0) return
+      if (ls+lc > string_size(s)) then
+          allocate(ss(ls+lc))
+          is = max(start,1)
+          ip = min(ls+1,is)
+          do i=1,ip-1
+              ss(i) = s%chars(i)
+          enddo
+          do i=ip,ip+lc-1
+              ss(i) = c(i-ip+1:i-ip+1)
+          enddo
+          do i=ip+lc,ls+lc
+              ss(i) = s%chars(i-lc)
+          enddo
+          deallocate(s%chars)
+
+          s%chars => ss
+
+          s%len = ls + lc
+          s%size = s%len
+      else
+          is = max(start,1)
+          ip = min(ls+1,is)
+          do i=ls+lc,ip+lc,-1
+              s%chars(i) = s%chars(i-lc)
+          enddo
+          do i=ip,ip+lc-1
+              s%chars(i) = c(i-ip+1:i-ip+1)
+          enddo
+          s%len = ls + lc
+      endif
+
+      end subroutine insert_in_string_c
+
+!*******************************************************************************
+!     REPLACE_IN_STRING
+!*******************************************************************************
+!     pure subroutine replace_in_string_ss_s(s,start,ss)
+!
+!     implicit none
+!     type(string), intent(inout)  :: s
+!     type(string), intent(in)     :: ss
+!     integer, intent(in)          :: start
+!
+!
+!     call replace_in_string_sc_s(s,start,char(ss))
+!
+!     end subroutine replace_in_string_ss_s
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ss_s(s,start,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,lr,lss,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_ss_s(s,start,ss)
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=lr,ip+lss,-1
+          rs(i) = s%chars(i)
+      enddo
+      do i=lss,1,-1
+          rs(ip-1+i) = ss%chars(i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_ss_s
+
+!*******************************************************************************
+!     pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+!
+!     implicit none
+!     type(string), intent(inout)  :: s
+!     type(string), intent(in)     :: ss
+!     integer, intent(in)          :: start,finish
+!
+!
+!     call replace_in_string_sc_sf(s,start,finish,char(ss))
+!
+!     end subroutine replace_in_string_ss_sf
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ss_sf(s,start,finish,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      integer, intent(in)          :: start,finish
+      integer                      :: i,if,ip,is,lr,ls,lss
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_ss_sf(s,start,finish,ss)
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=1,lr-ip-lss+1
+          rs(i+ip+lss-1) = s%chars(if+i)
+      enddo
+      do i=lss,1,-1
+          rs(i+ip-1) = ss%chars(i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_ss_sf
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sc_s(s,start,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start
+      integer                      :: i,ip,is,lc,lr,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_sc_s(s,start,c)
+      lc = len(c)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=lr,ip+lc,-1
+          rs(i) = s%chars(i)
+      enddo
+      do i=lc,1,-1
+          rs(ip-1+i) = c(i:i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_sc_s
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sc_sf(s,start,finish,c)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: c
+      integer, intent(in)          :: start,finish
+      integer                      :: i,if,ip,is,lc,lr,ls
+      character, pointer           :: rs(:)
+      logical                      :: new
+
+
+      lr = lr_sc_sf(s,start,finish,c)
+      lc = len(c)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+
+      new = lr > string_size(s)
+
+      if (new) then
+          allocate(rs(lr))
+      else
+          rs => s%chars
+      endif
+
+      do i=1,lr-ip-lc+1
+          rs(i+ip+lc-1) = s%chars(if+i)
+      enddo
+      do i=lc,1,-1
+          rs(i+ip-1) = c(i:i)
+      enddo
+      if (new) then
+          do i=1,ip-1
+              rs(i) = s%chars(i)
+          enddo
+      endif
+
+      if (new) then
+          deallocate(s%chars)
+          s%chars => rs
+          s%size = lr
+      else
+          nullify(rs)
+      endif
+      s%len = lr
+
+      end subroutine replace_in_string_sc_sf
+
+!*******************************************************************************
+!*******************************************************************************
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scc(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss
+
+
+      call x_replace_in_string_scc(s,target,ss,'first')
+
+
+      end subroutine replace_in_string_scc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scc_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss,action
+
+
+      call x_replace_in_string_scc(s,target,ss,action)
+
+      end subroutine replace_in_string_scc_f
+
+!*******************************************************************************
+
+      pure subroutine x_replace_in_string_scc(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      character(*), intent(in)     :: target,ss,action
+      logical                      :: every,back
+      integer                      :: lr,ls,lt,lss
+      integer                      :: i,i1,i2,k1,k2,m1,m2
+
+      character, pointer           :: rs(:)
+
+
+
+      lr = lr_scc(s,target,ss,action)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              do i=1,lss
+                  s%chars(i) = ss(i:i)
+              enddo
+              s%len = lss
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      allocate(rs(lr))
+
+      if (back) then
+!         Backwards search
+
+!         k2 points to the absolute position one before the target in string
+          k2 = ls
+          m2 = lr
+          do
+!             find the next occurrence of target
+              i1 = aindex(s%chars(:k2),target,back)
+              if (i1 == 0) then
+!                 fill up to the end
+                  rs(:m2) = s%chars(:k2)
+                  exit
+              endif
+!             i1 points to the absolute position of the first
+!             letter of target in string
+!             i2 points to the absolute position of the last
+!             letter of target in string
+              i2 = i1 + lt - 1
+
+!             copy the unaffected text string chunk after it
+!             k1 points to the absolute position one after target in string
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              rs(m1:m2) = s%chars(k1:k2)
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+!             copy the replacement substring for target
+              do i=1,lss
+                  rs(m1+i-1) = ss(i:i)
+              enddo
+
+!             k2 points to the absolute position one before the target in string
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not.every) then
+                  rs(:m2) = s%chars(:k2)
+                  exit
+              endif
+          enddo
+      else
+!         Forward search
+
+!         k1 points to the absolute position one after target in string
+          k1 = 1
+          m1 = 1
+          do
+!             find the next occurrence of target
+              i1 = aindex(s%chars(k1:),target)
+              if (i1 == 0) then
+!                 fill up to the end
+                  rs(m1:lr) = s%chars(k1:ls)
+                  exit
+              endif
+!             i1 points to the absolute position of the first
+!             letter of target in string
+              i1 = k1 + (i1 - 1)
+!             i2 points to the absolute position of the last
+!             letter of target in string
+              i2 = i1 + lt - 1
+
+!             copy the unaffected text string chunk before it
+!             k2 points to the absolute position one before the target in string
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              rs(m1:m2) = s%chars(k1:k2)
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+!             copy the replacement substring for target
+              do i=1,lss
+                  rs(m1+i-1) = ss(i:i)
+              enddo
+
+!             k1 points to the absolute position one after target in string
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not.every) then
+                  rs(m1:lr) = s%chars(k1:ls)
+                  exit
+              endif
+          enddo
+      endif
+
+
+      if (associated(s%chars)) deallocate(s%chars)
+      s%chars => rs
+
+      s%len = lr
+      s%size = size(s%chars)
+
+      end subroutine x_replace_in_string_scc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ssc(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: target
+      character(*), intent(in)     :: ss
+
+
+      call x_replace_in_string_scc(s,char(target),ss,'first')
+
+      end subroutine replace_in_string_ssc
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_ssc_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: target
+      character(*), intent(in)     :: ss,action
+
+
+      call x_replace_in_string_scc(s,char(target),ss,action)
+
+      end subroutine replace_in_string_ssc_f
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scs(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      character(*), intent(in)     :: target
+
+
+      call x_replace_in_string_scc(s,target,char(ss),'first')
+
+      end subroutine replace_in_string_scs
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_scs_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss
+      character(*), intent(in)     :: target,action
+
+
+      call x_replace_in_string_scc(s,target,char(ss),action)
+
+      end subroutine replace_in_string_scs_f
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sss(s,target,ss)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss,target
+
+
+      call x_replace_in_string_scc(s,char(target),char(ss),'first')
+
+      end subroutine replace_in_string_sss
+
+!*******************************************************************************
+
+      pure subroutine replace_in_string_sss_f(s,target,ss,action)
+
+      implicit none
+      type(string), intent(inout)  :: s
+      type(string), intent(in)     :: ss,target
+      character(*), intent(in)     :: action
+
+
+      call x_replace_in_string_scc(s,char(target),char(ss),action)
+
+      end subroutine replace_in_string_sss_f
+
+!*******************************************************************************
+!     REMOVE_FROM_STRING
+!*******************************************************************************
+
+      pure subroutine remove_from_string(s,start,finish)
+
+      implicit none
+      type(string), intent(inout)                      :: s
+      integer, intent(in)                              :: start,finish
+      integer                                          :: i,if,is,le,ls
+
+
+      is = max(1,start)
+      ls = len(s)
+      if = min(ls,finish)
+      if (if < is) return
+
+      le = if - is + 1            ! = len_extract
+      do i=if+1,ls
+          s%chars(i-le) = s%chars(i)
+      enddo
+      s%len = s%len - le
+
+      end subroutine remove_from_string
+
+!*******************************************************************************
+!     UNSTRING procedure
+!*******************************************************************************
+!     Deallocate the chars in the string to avoid leaking of memory
+!     Use this in functions and subroutines on locally declared variables
+!     of type string after their use. (I.e. garbage collecting).
+
+      elemental subroutine unstring(s)
+
+      implicit none
+      type(string), intent(inout)  :: s
+
+
+
+      if (associated(s%chars)) deallocate(s%chars)
+      nullify(s%chars)
+
+      s%size = 0
+      s%len = 0
+
+      end subroutine unstring
+
+!*******************************************************************************
+!     //
+!*******************************************************************************
+!     string // string
+
+      pure function s_concat_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)    :: s1,s2
+      character(len(s1)+len(s2))  :: s_concat_s
+      integer                     :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      s_concat_s(1:l1) = s1
+      s_concat_s(1+l1:l1+l2) = s2
+
+      end function s_concat_s
+
+!*******************************************************************************
+!     string // character
+
+      pure function s_concat_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      character(len(s)+len(c))  :: s_concat_c
+      integer                   :: ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      s_concat_c(1:ls) = s
+      s_concat_c(1+ls:ls+lc) = c
+
+      end function s_concat_c
+
+!*******************************************************************************
+!     character // string
+
+      pure function c_concat_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(len(s)+len(c))  :: c_concat_s
+      integer                   :: lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      c_concat_s(1:lc) = c
+      c_concat_s(1+lc:lc+ls) = s
+
+      end function c_concat_s
+
+!*******************************************************************************
+!     REPEAT
+!*******************************************************************************
+
+      function repeat_s(s,ncopies)
+
+      implicit none
+      type(string), intent(in)   :: s
+      integer, intent(in)        :: ncopies
+      character(ncopies*len(s))  :: repeat_s
+
+
+      if (ncopies < 0) stop 'Negative ncopies requested in REPEAT'
+      repeat_s = repeat(char(s),ncopies)
+
+      end function repeat_s
+
+!*******************************************************************************
+!     LEN_TRIM
+!*******************************************************************************
+
+      elemental function len_trim_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer                   :: len_trim_s
+
+      if (len(s) == 0) then
+        len_trim_s = 0
+        return
+      endif
+      do len_trim_s = len(s),1,-1
+          if (s%chars(len_trim_s) /= blank) return
+      end do
+
+      end function len_trim_s
+
+!*******************************************************************************
+!     TRIM
+!*******************************************************************************
+
+      pure function trim_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len_trim(s))    :: trim_s
+      integer                   :: i
+
+
+      do i=1,len(trim_s)
+          trim_s(i:i) = s%chars(i)
+      enddo
+
+      end function trim_s
+
+!*******************************************************************************
+!     IACHAR
+!*******************************************************************************
+! Returns the position of the character string in the ISO 646 collating
+! sequence. String must be of length one, otherwise result is as for
+! intrinsic iachar.
+
+      elemental function iachar_s(s)
+
+      implicit none
+      type(string), intent(in) :: s
+      integer                  :: iachar_s
+
+
+      iachar_s = iachar(char(s))
+
+      end function iachar_s
+
+!*******************************************************************************
+!     ICHAR
+!*******************************************************************************
+! Returns the position of character from string in the processor collating
+! sequence. String must be of length one, otherwise it will behave as the
+! intrinsic ichar with the equivalent character string.
+
+      elemental function ichar_s(s)
+
+      implicit none
+      type(string), intent(in) ::  s
+      integer                  ::  ichar_s
+
+
+      ichar_s = ichar(char(s))
+
+      end function ichar_s
+
+!*******************************************************************************
+!     ADJUSTL
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the left,
+! removing leading blanks and inserting trailing blanks.
+
+      pure function adjustl_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len(s))         :: adjustl_s
+
+
+      adjustl_s = adjustl(char(s))
+
+      end function adjustl_s
+
+!*******************************************************************************
+!     ADJUSTR
+!*******************************************************************************
+! Returns as a character variable the string adjusted to the right,
+! removing trailing blanks and inserting leading blanks.
+
+      pure function adjustr_s(s)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(len(s))         :: adjustr_s
+
+
+      adjustr_s = adjustr(char(s))
+
+      end function adjustr_s
+
+!*******************************************************************************
+!    LEN_STRIP
+!*******************************************************************************
+
+     elemental function len_strip_s(s)
+
+     implicit none
+     type(string), intent(in) :: s
+     integer                  :: len_strip_s
+     integer                  :: i1,i2
+
+
+     do i1=1,len(s)
+         if (s%chars(i1) /= blank) exit
+     enddo
+     do i2=len(s),1,-1
+         if (s%chars(i2) /= blank) exit
+     enddo
+     len_strip_s = max(0,i2-i1+1)
+
+     end function len_strip_s
+
+!*******************************************************************************
+!    STRIP
+!*******************************************************************************
+
+     pure function strip_s(s)
+
+     implicit none
+     type(string), intent(in)  :: s
+     character(len_strip(s))   :: strip_s
+     integer                   :: i,j
+
+
+     do i=1,len(s)
+         if (s%chars(i) /= blank) exit
+     enddo
+     do j=1,len(strip_s)
+         strip_s(j:j) = s%chars(i+j-1)
+     enddo
+
+     end function strip_s
+
+!*******************************************************************************
+
+     elemental function len_strip_c(c)
+
+     implicit none
+     character(*), intent(in) :: c
+     integer                  :: len_strip_c
+     integer                  :: i1,i2
+
+
+     do i1=1,len(c)
+         if (c(i1:i1) /= blank) exit
+     enddo
+     i2 = len_trim(c)
+     len_strip_c = max(0,i2-i1+1)
+
+     end function len_strip_c
+
+!*******************************************************************************
+
+     pure function strip_c(c)
+
+     implicit none
+     character(*), intent(in)  :: c
+     character(len_strip(c))   :: strip_c
+     integer                   :: i
+
+
+     do i=1,len(c)
+         if (c(i:i) /= blank) exit
+     enddo
+     strip_c(1:) = c(i:)
+
+     end function strip_c
+
+!*******************************************************************************
+!     EXTRACT
+!*******************************************************************************
+      elemental FUNCTION len_extract_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)  :: s
+      integer, intent(in)       :: start,finish
+      integer                   :: len_extract_s
+      integer                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(s),finish)
+      if (if < is) then
+          len_extract_s = 0
+      else
+          len_extract_s = max(0,if-is) + 1
+      endif
+
+      end function len_extract_s
+
+!*****************************************************
+      pure function extract_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)                  :: s
+      integer, intent(in)                       :: start,finish
+      character(len_extract_s(s,start,finish))  :: extract_s
+      integer                                   :: i,is,if
+
+
+      is = max(1,start)
+      if = min(len(s),finish)
+      if (if < is) then
+          extract_s = ''
+      else
+          do i=1,max(0,if-is+1)
+              extract_s(i:i) = s%chars(is+i-1)
+          enddo
+      endif
+
+      end function extract_s
+
+!*******************************************************************************
+
+!      elemental FUNCTION len_extract_s(s,start,finish)
+
+!      implicit none
+!      type(string), intent(in)  :: s
+!      integer, intent(in)       :: start,finish
+!      integer                   :: len_extract_s
+!      integer                   :: is,if
+
+
+!      is = max(1,start)
+!      if = min(len(s),finish)
+!      if (if < is) then
+!          len_extract_s = 0
+!      else
+!          len_extract_s = max(0,if-is) + 1
+!      endif
+
+!      end function len_extract_s
+
+!*******************************************************************************
+
+      elemental function len_extract_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)  :: c
+      integer, intent(in)       :: start,finish
+      integer                   :: len_extract_c
+      integer                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(c),finish)
+      if (if < is) then
+          len_extract_c = 0
+      else
+          len_extract_c = max(0,if-is) + 1
+      endif
+
+      end function len_extract_c
+
+!*******************************************************************************
+
+      pure function extract_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)                  :: c
+      integer, intent(in)                       :: start,finish
+      character(len_extract_c(c,start,finish))  :: extract_c
+      integer                                   :: is,if
+
+
+      is = max(1,start)
+      if = min(len(c),finish)
+      if (if < is) then
+          extract_c = ''
+      else
+          extract_c(1:if-is+1) = c(is:if)
+      endif
+
+      end function extract_c
+
+!*******************************************************************************
+
+!      elemental function len_extract_c(c,start,finish)
+
+!      implicit none
+!      character(*), intent(in)  :: c
+!      integer, intent(in)       :: start,finish
+!      integer                   :: len_extract_c
+!      integer                   :: is,if
+
+
+!      is = max(1,start)
+!      if = min(len(c),finish)
+!      if (if < is) then
+!          len_extract_c = 0
+!      else
+!          len_extract_c = max(0,if-is) + 1
+!      endif
+
+!      end function len_extract_c
+
+!*******************************************************************************
+!     INSERT
+!*******************************************************************************
+
+      pure function insert_ss(s1,start,s2)
+
+      implicit none
+      type(string), intent(in)    :: s1,s2
+      integer, intent(in)         :: start
+      character(len(s1)+len(s2))  :: insert_ss
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(s1)
+      ls2 = len(s2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      do i=1,ip-1
+          insert_ss(i:i) = s1%chars(i)
+      enddo
+      do i=ip,ip+ls2-1
+          insert_ss(i:i) = s2%chars(i-ip+1)
+      enddo
+      do i=ip+ls2,ls1+ls2
+          insert_ss(i:i) = s1%chars(i-ls2)
+      enddo
+
+      end function insert_ss
+
+!*******************************************************************************
+
+      pure function insert_sc(s1,start,c2)
+
+      implicit none
+      type(string), intent(in)    :: s1
+      character(*), intent(in)    :: c2
+      integer, intent(in)         :: start
+      character(len(s1)+len(c2))  :: insert_sc
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(s1)
+      ls2 = len(c2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      do i=1,ip-1
+          insert_sc(i:i) = s1%chars(i)
+      enddo
+      insert_sc(ip:ip+ls2-1) = c2
+      do i=ip+ls2,ls1+ls2
+          insert_sc(i:i) = s1%chars(i-ls2)
+      enddo
+
+      end function insert_sc
+
+!*******************************************************************************
+
+      pure function insert_cs(c1,start,s2)
+
+      implicit none
+      character(*), intent(in)    :: c1
+      type(string), intent(in)    :: s2
+      integer, intent(in)         :: start
+      character(len(c1)+len(s2))  :: insert_cs
+      integer                     :: i,ip,is,ls1,ls2
+
+
+      ls1 = len(c1)
+      ls2 = len(s2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      insert_cs(1:ip-1) = c1(1:ip-1)
+      do i=ip,ip+ls2-1
+          insert_cs(i:i) = s2%chars(i-ip+1)
+      enddo
+      insert_cs(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+      end function insert_cs
+
+!*******************************************************************************
+
+      pure function insert_cc(c1,start,c2)
+
+      implicit none
+      character(*), intent(in)    :: c1,c2
+      integer, intent(in)         :: start
+      character(len(c1)+len(c2))  :: insert_cc
+      integer                     :: ip,is,ls1,ls2
+
+
+      ls1 = len(c1)
+      ls2 = len(c2)
+      is = max(start,1)
+      ip = min(ls1+1,is)
+      insert_cc(1:ip-1) = c1(1:ip-1)
+      insert_cc(ip:ip+ls2-1) = c2
+      insert_cc(ip+ls2:ls1+ls2) = c1(ip:ls1)
+
+      end function insert_cc
+
+!*******************************************************************************
+!     REMOVE
+!*******************************************************************************
+
+      pure function remove_c(c,start,finish)
+
+      implicit none
+      character(*), intent(in)                         :: c
+      integer, intent(in)                              :: start,finish
+      character(len(c)-len_extract_c(c,start,finish))  :: remove_c
+      integer                                          :: if,is,ls
+
+
+      is = max(1,start)
+      ls = len(c)
+      if = min(ls,finish)
+      if (if < is) then
+          remove_c = c
+      else
+          remove_c = c(1:is-1) // c(if+1:)
+      endif
+
+      end function remove_c
+
+!*******************************************************************************
+
+      pure function remove_s(s,start,finish)
+
+      implicit none
+      type(string), intent(in)                         :: s
+      integer, intent(in)                              :: start,finish
+      character(len(s)-len_extract_s(s,start,finish))  :: remove_s
+      integer                                          :: i,if,is,le,ls
+
+
+      is = max(1,start)
+      ls = len(s)
+      if = min(ls,finish)
+      if (if < is) then
+           remove_s = s
+      else
+          le = if - is + 1
+          do i=1,is-1
+              remove_s(i:i) = s%chars(i)
+          enddo
+          do i=if+1,ls
+              remove_s(i-le:i-le) = s%chars(i)
+          enddo
+      endif
+
+      end function remove_s
+
+!*******************************************************************************
+!     REPLACE
+!*******************************************************************************
+
+      pure function lr_cc_s(s,start,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s,ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_cc_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_cc_s(s,start,ss) result(r)
+
+      implicit none
+      character(*), intent(in)        :: s,ss
+      integer, intent(in)             :: start
+      character(lr_cc_s(s,start,ss))  :: r
+      integer                         :: ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      r(ip:ip+lss-1) = ss
+      r(ip+lss:l) = s(ip+lss:ls)
+
+      end function replace_cc_s
+
+!*******************************************************************************
+
+      pure function lr_cc_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s,ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_cc_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_cc_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s,ss
+      integer, intent(in)                     :: start,finish
+      character(lr_cc_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss(i:i)
+      enddo
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+      enddo
+
+      end function replace_cc_sf
+
+!*******************************************************************************
+
+      pure function lr_cs_s(s,start,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s
+      type(string), intent(in)  :: ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_cs_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_cs_s(s,start,ss) result(r)
+
+      implicit none
+      character(*), intent(in)        :: s
+      type(string), intent(in)        :: ss
+      integer, intent(in)             :: start
+      character(lr_cs_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+      r(ip:ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+      r(ip+lss:l) = s(ip+lss:ls)
+
+      end function replace_cs_s
+
+!*******************************************************************************
+
+      pure function lr_cs_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      character(*), intent(in)  :: s
+      type(string), intent(in)  :: ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_cs_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_cs_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s
+      type(string), intent(in)                :: ss
+      integer, intent(in)                     :: start,finish
+      character(lr_cs_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      r(1:ip-1) = s(1:ip-1)
+
+      r(i+ip:i+ip+lss-1) = transfer(ss%chars(1:lss),r(1:lss))
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss%chars(i)
+      enddo
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s(if+i:if+i)
+      enddo
+
+      end function replace_cs_sf
+
+!*******************************************************************************
+
+      pure function lr_sc_s(s,start,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_sc_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_sc_s(s,start,ss) result(r)
+
+      implicit none
+      type(string), intent(in)        :: s
+      character(*), intent(in)        :: ss
+      integer, intent(in)             :: start
+      character(lr_sc_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss(i:i)
+      enddo
+
+      do i=ip+lss,l
+          r(i:i) = s%chars(i)
+      enddo
+
+      end function replace_sc_s
+
+!*******************************************************************************
+
+      pure function lr_sc_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_sc_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_sc_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s
+      character(*), intent(in)                :: ss
+      integer, intent(in)                     :: start,finish
+      character(lr_sc_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      r(ip:ip+lss-1) = ss
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+      enddo
+
+      end function replace_sc_sf
+
+!*******************************************************************************
+
+      pure function lr_ss_s(s,start,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s,ss
+      integer, intent(in)       :: start
+      integer                   :: l
+      integer                   :: ip,is,ls,lss
+
+
+      l = max(len(s),min(len(s)+1,max(start,1)+len(ss)-1))
+
+      end function lr_ss_s
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Insert the characters from substring SS into string STR beginning
+!  at position START replacing the following LEN(SUBSTRING) characters of
+!  the string and enlarging string if necessary. If START is greater than
+!  LEN(STRING) substring is simply appended to string by concatenation.
+!  If START is less than 1, substring replaces characters in string
+!  starting at 1
+
+      function replace_ss_s(s,start,ss) result(r)
+
+      implicit none
+      type(string), intent(in)        :: s,ss
+      integer, intent(in)             :: start
+      character(lr_ss_s(s,start,ss))  :: r
+      integer                         :: i,ip,is,l,lss,ls
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(ip-1+i:ip-1+i) = ss%chars(i)
+      enddo
+
+      do i=ip+lss,l
+          r(i:i) = s%chars(i)
+      enddo
+
+      end function replace_ss_s
+
+!*******************************************************************************
+
+      pure function lr_ss_sf(s,start,finish,ss) result(l)
+
+      implicit none
+      type(string), intent(in)  :: s,ss
+      integer, intent(in)       :: start,finish
+      integer                   :: l
+      integer                   :: if,ip,is,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = lss + ls - if+ip-1
+
+      end function lr_ss_sf
+
+!*******************************************************************************
+!  Calculates the result string by the following actions:
+!  Insert the substring SS into string STR beginning at position
+!  START replacing the following FINISH-START+1 characters of the string
+!  and enlarging or shrinking the string if necessary.
+!  If start is greater than LEN(STRING) substring is simply appended to
+!  string by concatenation. If START is less than 1, START = 1 is used.
+!  If FINISH is greater than LEN(STRING), FINISH = LEN(STRING) is used.
+!  If FINISH is less than START, substring is inserted before START.
+
+      function replace_ss_sf(s,start,finish,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s,ss
+      integer, intent(in)                     :: start,finish
+      character(lr_ss_sf(s,start,finish,ss))  :: r
+      integer                                 :: i,if,ip,is,l,ls,lss
+
+
+      lss = len(ss)
+      ls = len(s)
+      is = max(start,1)
+      ip = min(ls+1,is)
+      if = max(ip-1,min(finish,ls))
+      l = len(r)
+
+      do i=1,ip-1
+          r(i:i) = s%chars(i)
+      enddo
+
+      do i=1,lss
+          r(i+ip-1:i+ip-1) = ss%chars(i)
+      enddo
+
+      do i=1,l-ip-lss+1
+          r(i+ip+lss-1:i+ip+lss-1) = s%chars(if+i)
+      enddo
+
+      end function replace_ss_sf
+
+!*******************************************************************************
+
+      pure function lr_ccc(s,target,ss,action) result(l)
+
+      implicit none
+      character(*), intent(in)       :: s,target,ss,action
+      integer                        :: l
+      logical                        :: every,back
+      integer                        :: ls,lt,lss,ipos,nr
+
+
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              l = lss
+          else
+              l = ls
+          endif
+          return
+      endif
+
+      if (lt == lss) then
+          l = ls
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      nr = 0
+      if (back) then
+          ipos = ls
+          do while (ipos > 0)
+              ipos = index(s(:ipos),target,back)
+              if (ipos == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos - 1
+          enddo
+      else
+          ipos = 1
+          do while (ipos <= ls-lt+1)
+              l = index(s(ipos:),target)
+              if (l == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos + l + 1
+              ipos = ipos + 1
+          enddo
+      endif
+      l = ls + nr*(lss-lt)
+
+      end function lr_ccc
+
+!*******************************************************************************
+
+      function replace_ccc(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                :: s,target,ss
+      character(lr_ccc(s,target,ss,'first'))  :: r
+
+
+      call x_replace_ccc(s,target,ss,'first',r)
+
+      end function replace_ccc
+
+!*******************************************************************************
+
+      function replace_ccc_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)               :: s,target,ss,action
+      character(lr_ccc(s,target,ss,action))  :: r
+
+
+      call x_replace_ccc(s,target,ss,action,r)
+
+      end function replace_ccc_f
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Search for occurences of TARGET in string S, and replaces these with
+!  substring SS.  If BACK present with value true search is backward otherwise
+!  search is done forward.  If EVERY present with value true all accurences
+!  of TARGET in S are replaced, otherwise only the first found is
+!  replaced.  If TARGET is not found the result is the same as S.
+
+      subroutine x_replace_ccc(s,target,ss,action,r)
+
+      implicit none
+      character(*), intent(in)               :: s,target,ss,action
+      character(*), intent(inout)            :: r
+      logical                                :: every,back
+      integer                                :: lr,ls,lt,lss
+      integer                                :: i1,i2,k1,k2,m1,m2
+
+
+      lr = len(r)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              r = ss
+          else
+              r = s
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      if (back) then
+          k2 = ls
+          m2 = lr
+          do
+              i1 = index(s(:k2),target,back)
+              if (i1 == 0) then
+                  r(:m2) = s(:k2)
+                  return
+              endif
+              i2 = i1 + lt - 1
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              r(m1:m2) = s(k1:k2)
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+              r(m1:m2) = ss
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not. every) then
+                  r(:m2) = s(:k2)
+                  return
+              endif
+          enddo
+      else
+          k1 = 1
+          m1 = 1
+          do
+              i1 = index(s(k1:),target)
+              if (i1 == 0) then
+                  r(m1:) = s(k1:)
+                  return
+              endif
+              i1 = k1 + (i1 - 1)
+              i2 = i1 + lt - 1
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              r(m1:m2) = s(k1:k2)
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+              r(m1:m2) = ss
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not. every) then
+                  r(m1:) = s(k1:)
+                  return
+              endif
+          enddo
+      endif
+
+      end subroutine x_replace_ccc
+
+!*******************************************************************************
+
+      function replace_csc(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                      :: s,ss
+      type(string), intent(in)                      :: target
+      character(lr_ccc(s,char(target),ss,'first'))  :: r
+
+
+      call x_replace_ccc(s,char(target),ss,'first',r)
+
+      end function replace_csc
+
+!*******************************************************************************
+
+      function replace_csc_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                     :: s,ss,action
+      type(string), intent(in)                     :: target
+      character(lr_ccc(s,char(target),ss,action))  :: r
+
+
+      call x_replace_ccc(s,char(target),ss,action,r)
+
+      end function replace_csc_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+      function replace_ccs(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                      :: s,target
+      type(string), intent(in)                      :: ss
+      character(lr_ccc(s,target,char(ss),'first'))  :: r
+
+
+      call x_replace_ccc(s,target,char(ss),'first',r)
+
+      end function replace_ccs
+
+!*******************************************************************************
+
+      function replace_ccs_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                     :: s,target,action
+      type(string), intent(in)                     :: ss
+      character(lr_ccc(s,target,char(ss),action))  :: r
+
+
+      call x_replace_ccc(s,target,char(ss),action,r)
+
+      end function replace_ccs_f
+
+!*******************************************************************************
+!*******************************************************************************
+
+      function replace_css(s,target,ss) result(r)
+
+      implicit none
+      character(*), intent(in)                            :: s
+      type(string), intent(in)                            :: ss,target
+      character(lr_ccc(s,char(target),char(ss),'first'))  :: r
+
+
+      call x_replace_ccc(s,char(target),char(ss),'first',r)
+
+      end function replace_css
+
+!*******************************************************************************
+
+      function replace_css_f(s,target,ss,action) result(r)
+
+      implicit none
+      character(*), intent(in)                           :: s,action
+      type(string), intent(in)                           :: ss,target
+      character(lr_ccc(s,char(target),char(ss),action))  :: r
+
+
+      call x_replace_ccc(s,char(target),char(ss),action,r)
+
+      end function replace_css_f
+
+!*******************************************************************************
+!*******************************************************************************
+      pure function lr_scc(s,target,ss,action) result(l)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: target,ss,action
+      integer                        :: l
+      logical                        :: every,back
+      integer                        :: ls,lt,lss,ipos,nr
+
+
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              l = lss
+          else
+              l = ls
+          endif
+          return
+      endif
+      if (lt == lss) then
+          l = ls
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      nr = 0
+      if (back) then
+          ipos = ls
+          do while (ipos > 0)
+              ipos = aindex(s%chars(:ipos),target,back)
+              if (ipos == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos - 1
+          enddo
+
+      else
+          ipos = 1
+          do while (ipos <= ls-lt+1)
+              l = aindex(s%chars(ipos:),target)
+              if (l == 0) exit
+              nr = nr + 1
+              if (.not. every) exit
+              ipos = ipos + l + 1
+          enddo
+      endif
+      l = ls + nr*(lss-lt)
+
+      end function lr_scc
+
+!*******************************************************************************
+
+      function replace_scc(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                :: s
+      character(*), intent(in)                :: target,ss
+      character(lr_scc(s,target,ss,'first'))  :: r
+
+
+      call x_replace_scc(s,target,ss,'first',r)
+
+
+      end function replace_scc
+
+!*******************************************************************************
+
+      function replace_scc_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)               :: s
+      character(*), intent(in)               :: target,ss,action
+      character(lr_scc(s,target,ss,action))  :: r
+
+
+      call x_replace_scc(s,target,ss,action,r)
+
+      end function replace_scc_f
+
+!*******************************************************************************
+!  Calculate the result string by the following actions:
+!  Search for occurences of TARGET in string S, and replaces these with
+!  substring SS.  If BACK present with value true search is backward otherwise
+!  search is done forward.  If EVERY present with value true all accurences
+!  of TARGET in S are replaced, otherwise only the first found is
+!  replaced.  If TARGET is not found the result is the same as S.
+
+      subroutine x_replace_scc(s,target,ss,action,r)
+
+      implicit none
+      type(string), intent(in)               :: s
+      character(*), intent(in)               :: target,ss,action
+      character(*), intent(inout)            :: r
+      logical                                :: every,back
+      integer                                :: lr,ls,lt,lss
+      integer                                :: i1,i2,k1,k2,m1,m2
+
+
+      lr = len(r)
+      ls = len(s)
+      lt = len(target)
+      lss = len(ss)
+
+      if (lt == 0) then
+          if (ls == 0) then
+              r = ss
+          else
+              r = s
+          endif
+          return
+      endif
+
+      select case(uppercase(action))
+      case('FIRST')
+          back = .false.
+          every = .false.
+      case('LAST')
+          back = .true.
+          every = .false.
+      case('ALL')
+          back = .false.
+          every = .true.
+      case default
+          back = .false.
+          every = .false.
+      end select
+
+      if (back) then
+          k2 = ls
+          m2 = lr
+          do
+              i1 = aindex(s%chars(:k2),target,back)
+              if (i1 == 0) then
+                  r(:m2) = transfer(s%chars(:k2),r(:m2))
+                  return
+              endif
+              i2 = i1 + lt - 1
+              k1 = i2 + 1
+              m1 = m2 + k1 - k2
+              r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+              m2 = m1 - 1
+              m1 = m2 - lss + 1
+              r(m1:m2) = ss
+              k2 = i1 - 1
+              m2 = m1 - 1
+              if (.not.every) then
+                  r(:m2) = transfer(s%chars(:k2),r(:m2))
+                  return
+              endif
+          enddo
+      else
+          k1 = 1
+          m1 = 1
+          do
+              i1 = aindex(s%chars(k1:),target)
+              if (i1 == 0) then
+                  r(m1:) = transfer(s%chars(k1:),r(m1:))
+                  return
+              endif
+              i1 = k1 + (i1 - 1)
+              i2 = i1 + lt - 1
+              k2 = i1 - 1
+              m2 = m1 + k2 - k1
+              r(m1:m2) = transfer(s%chars(k1:k2),r(m1:m2))
+              m1 = m2 + 1
+              m2 = m1 + lss - 1
+              r(m1:m2) = ss
+              k1 = i2 + 1
+              m1 = m2 + 1
+              if (.not.every) then
+                  r(m1:) = transfer(s%chars(k1:),r(m1:))
+                  return
+              endif
+          enddo
+      endif
+
+      end subroutine x_replace_scc
+
+!*******************************************************************************
+
+      function replace_ssc(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                      :: s,target
+      character(*), intent(in)                      :: ss
+      character(lr_scc(s,char(target),ss,'first'))  :: r
+
+
+      call x_replace_scc(s,char(target),ss,'first',r)
+
+
+      end function replace_ssc
+
+!*******************************************************************************
+
+      function replace_ssc_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                     :: s,target
+      character(*), intent(in)                     :: ss,action
+      character(lr_scc(s,char(target),ss,action))  :: r
+
+
+      call x_replace_scc(s,char(target),ss,action,r)
+
+      end function replace_ssc_f
+
+!*******************************************************************************
+
+      function replace_scs(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                      :: s,ss
+      character(*), intent(in)                      :: target
+      character(lr_scc(s,target,char(ss),'first'))  :: r
+
+
+      call x_replace_scc(s,target,char(ss),'first',r)
+
+      end function replace_scs
+
+!*******************************************************************************
+
+      function replace_scs_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                     :: s,ss
+      character(*), intent(in)                     :: target,action
+      character(lr_scc(s,target,char(ss),action))  :: r
+
+
+      call x_replace_scc(s,target,char(ss),action,r)
+
+      end function replace_scs_f
+
+!*******************************************************************************
+
+      function replace_sss(s,target,ss) result(r)
+
+      implicit none
+      type(string), intent(in)                            :: s,ss,target
+      character(lr_scc(s,char(target),char(ss),'first'))  :: r
+
+
+      call x_replace_scc(s,char(target),char(ss),'first',r)
+
+      end function replace_sss
+
+!*******************************************************************************
+
+      function replace_sss_f(s,target,ss,action) result(r)
+
+      implicit none
+      type(string), intent(in)                           :: s,ss,target
+      character(*), intent(in)                           :: action
+      character(lr_scc(s,char(target),char(ss),action))  :: r
+
+
+      call x_replace_scc(s,char(target),char(ss),action,r)
+
+      end function replace_sss_f
+
+!*******************************************************************************
+!     SORT, LSORT
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine sort_c(a)
+
+      implicit none
+      character(*), intent(inout)  :: a(:)
+      character(len(a))            :: t,s
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      t = a(p)
+      if (a(i) > t) then
+          a(p) = a(i)
+          a(i) = t
+          t = a(p)
+      endif
+      if (a(j) < t) then
+          a(p) = a(j)
+          a(j) = t
+          t = a(p)
+          if (a(i) > t) then
+              a(p) = a(i)
+              a(i) = t
+              t = a(p)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(l) <= t) exit
+          enddo
+          s = a(l)
+          do
+              k = k + 1
+              if (a(k) >= t) exit
+          enddo
+          if (k > l) exit
+          a(l) = a(k)
+          a(k) = s
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          t = a(i+1)
+          if (a(i) <= t) cycle
+          k = i
+          do
+              a(k+1) = a(k)
+              k = k - 1
+              if (t >= a(k)) exit
+          enddo
+          a(k+1) = t
+      enddo
+
+      end subroutine sort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine sort_s(a)
+
+      implicit none
+      type(string), intent(inout)  :: a(:)
+      type(string)                 :: s,t
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      call pstring(t,a(p))
+      if (a(i) > t) then
+          call pstring(a(p),a(i))
+          call pstring(a(i),t)
+          call pstring(t,a(p))
+      endif
+      if (a(j) < t) then
+          call pstring(a(p),a(j))
+          call pstring(a(j),t)
+          call pstring(t,a(p))
+          if (a(i) > t) then
+              call pstring(a(p),a(i))
+              call pstring(a(i),t)
+              call pstring(t,a(p))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(l) <= t) exit
+          enddo
+          call pstring(s,a(l))
+          do
+              k = k + 1
+              if (a(k) >= t) exit
+          enddo
+          if (k > l) exit
+          call pstring(a(l),a(k))
+          call pstring(a(k),s)
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          call pstring(t,a(i+1))
+          if (a(i) <= t) cycle
+          k = i
+          do
+              call pstring(a(k+1),a(k))
+              k = k - 1
+              if (t >= a(k)) exit
+          enddo
+          call pstring(a(k+1),t)
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine sort_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+      subroutine lsort_c(a)
+
+      implicit none
+      character(*), intent(inout)  :: a(:)
+      character(len(a))            :: t,s
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      t = a(p)
+      if (lgt(a(i),t)) then
+          a(p) = a(i)
+          a(i) = t
+          t = a(p)
+      endif
+      if (llt(a(j),t)) then
+          a(p) = a(j)
+          a(j) = t
+          t = a(p)
+          if (lgt(a(i),t)) then
+              a(p) = a(i)
+              a(i) = t
+              t = a(p)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(l),t)) exit
+          enddo
+          s = a(l)
+          do
+              k = k + 1
+              if (lge(a(k),t)) exit
+          enddo
+          if (k > l) exit
+          a(l) = a(k)
+          a(k) = s
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          t = a(i+1)
+          if (lle(a(i),t)) cycle
+          k = i
+          do
+              a(k+1) = a(k)
+              k = k - 1
+              if (lge(t,a(k))) exit
+          enddo
+          a(k+1) = t
+      enddo
+
+      end subroutine lsort_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lsort_s(a)
+
+      implicit none
+      type(string), intent(inout)  :: a(:)
+      type(string)                 :: s,t
+      integer                      :: p,i,j,k,l,m
+      integer                      :: is(0:63)
+
+
+      m = 0
+      i = 1
+      j = size(a)
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (i + j)/2
+      call pstring(t,a(p))
+      if (lgt(a(i),t)) then
+          call pstring(a(p),a(i))
+          call pstring(a(i),t)
+          call pstring(t,a(p))
+      endif
+      if (llt(a(j),t)) then
+          call pstring(a(p),a(j))
+          call pstring(a(j),t)
+          call pstring(t,a(p))
+          if (lgt(a(i),t)) then
+              call pstring(a(p),a(i))
+              call pstring(a(i),t)
+              call pstring(t,a(p))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(l),t)) exit
+          enddo
+          call pstring(s,a(l))
+          do
+              k = k + 1
+              if (lge(a(k),t)) exit
+          enddo
+          if (k > l) exit
+          call pstring(a(l),a(k))
+          call pstring(a(k),s)
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          call pstring(t,a(i+1))
+          if (lle(a(i),t)) cycle
+          k = i
+          do
+              call pstring(a(k+1),a(k))
+              k = k - 1
+              if (lge(t,a(k))) exit
+          enddo
+          call pstring(a(k+1),t)
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine lsort_s
+
+!*******************************************************************************
+!     RANK, LRANK
+!*******************************************************************************
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+! reproduced with permission.
+!*******************************************************************************
+
+      subroutine rank_c(a,r)
+
+      implicit none
+      character(*), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      character(len(a))         :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      t = a(rt)
+      if (a(r(i)) > t) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          t = a(rt)
+      endif
+      if (a(r(j)) < t) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          t = a(rt)
+          if (a(r(i)) > t) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              t = a(rt)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(r(l)) <= t) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (a(r(k)) >= t) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          t = a(rt)
+          if (a(r(i)) <= t) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (t >= a(r(k))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      end subroutine rank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine rank_s(a,r)
+
+      implicit none
+      type(string), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      type(string)              :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      call pstring(t,a(rt))
+      if (a(r(i)) > t) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+      endif
+      if (a(r(j)) < t) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+          if (a(r(i)) > t) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              call pstring(t,a(rt))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (a(r(l)) <= t) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (a(r(k)) >= t) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          call pstring(t,a(rt))
+          if (a(r(i)) <= t) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (t >= a(r(k))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine rank_s
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lrank_c(a,r)
+
+      implicit none
+      character(*), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      character(len(a))         :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      t = a(rt)
+      if (lgt(a(r(i)),t)) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          t = a(rt)
+      endif
+      if (llt(a(r(j)),t)) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          t = a(rt)
+          if (llt(a(r(i)),t)) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              t = a(rt)
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(r(l)),t)) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (lge(a(r(k)),t)) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          t = a(rt)
+          if (lle(a(r(i)),t)) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (lge(t,a(r(k)))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      end subroutine lrank_c
+
+!*******************************************************************************
+! Sorts A into ascending order, from A(1) to A(N).
+! Reference: Richard C. Singleton, Algorithm 347, SORT.
+! Comm. ACM 3, 321 (March 1969).
+! Algorithm is Copyright 1969 Association of Computing Machinery,
+!*******************************************************************************
+
+      subroutine lrank_s(a,r)
+
+      implicit none
+      type(string), intent(in)  :: a(:)
+      integer, intent(out)      :: r(size(a))
+      type(string)              :: t
+      integer                   :: i,j,k,l,m,n,p,rs,rt
+      integer                   :: is(0:63)
+
+
+      n = size(a)
+      r(:) = (/ (i, i=1,n) /)
+      m = 0
+      i = 1
+      j = n
+
+    5 continue
+      if (i >= j) goto 70
+
+   10 continue
+      p = (j+i)/2
+      rt = r(p)
+      call pstring(t,a(rt))
+      if (lgt(a(r(i)),t)) then
+          r(p) = r(i)
+          r(i) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+      endif
+      if (llt(a(r(j)),t)) then
+          r(p) = r(j)
+          r(j) = rt
+          rt = r(p)
+          call pstring(t,a(rt))
+          if (lgt(a(r(i)),t)) then
+              r(p) = r(i)
+              r(i) = rt
+              rt = r(p)
+              call pstring(t,a(rt))
+          endif
+      endif
+
+      k = i
+      l = j
+      do
+          do
+              l = l - 1
+              if (lle(a(r(l)),t)) exit
+          enddo
+          rs = r(l)
+          do
+              k = k + 1
+              if (lge(a(r(k)),t)) exit
+          enddo
+          if (k > l) exit
+          r(l) = r(k)
+          r(k) = rs
+      enddo
+
+      if (l-i > j-k) then
+          is(m) = i
+          m = m + 1
+          is(m) = l
+          m = m + 1
+          i = k
+      else
+          is(m) = k
+          m = m + 1
+          is(m) = j
+          m = m + 1
+          j = l
+      endif
+      goto 80
+
+   70 continue
+      if (m == 0) return
+      m = m - 1
+      j = is(m)
+      m = m - 1
+      i = is(m)
+
+   80 continue
+      if (j-i >= 11) goto 10
+      if (i == 1) goto 5
+      i = i - 1
+
+      do
+          i = i + 1
+          if (i == j) goto 70
+          rt = r(i+1)
+          call pstring(t,a(rt))
+          if (lle(a(r(i)),t)) cycle
+          k = i
+          do
+              r(k+1) = r(k)
+              k = k - 1
+              if (lge(t,a(r(k)))) exit
+          enddo
+          r(k+1) = rt
+      enddo
+
+      contains
+
+!-------------------------------------------------------------------------------
+      subroutine pstring(p,t)
+
+      implicit none
+      type(string), intent(inout)  :: p
+      type(string), intent(in)     :: t
+
+
+      p%len = t%len
+      p%size = t%size
+      p%chars => t%chars
+
+
+      end subroutine pstring
+!-------------------------------------------------------------------------------
+
+      end subroutine lrank_s
+
+!*******************************************************************************
+!     COMPARE, LCOMPARE, ACOMPARE, ALCOMPARE
+!*******************************************************************************
+!*******************************************************************************
+
+      elemental function compare_ss(s1,s2) result(css)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      character(2)              :: css
+      integer                   :: i,l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      do i=1,min(l1,l2)
+          if (s1%chars(i) < s2%chars(i)) then
+              css = 'LT'
+              return
+          elseif (s1%chars(i) > s2%chars(i)) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (blank < s2%chars(i)) then
+                  css = 'LT'
+                  return
+              elseif (blank > s2%chars(i)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (s1%chars(i) < blank) then
+                  css = 'LT'
+                  return
+              elseif (s1%chars(i) > blank) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function compare_ss
+
+!*******************************************************************************
+
+      elemental function compare_cs(c,s) result(css)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(2)              :: css
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) < s%chars(i)) then
+              css = 'LT'
+              return
+          elseif (c(i:i) > s%chars(i)) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (lc < ls) then
+          do i=lc+1,ls
+              if (blank < s%chars(i)) then
+                  css = 'LT'
+                  return
+              elseif (blank > s%chars(i)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > ls) then
+          do i=ls+1,lc
+              if (c(i:i) < blank) then
+                  css = 'LT'
+                  return
+              elseif (c(i:i) > blank) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function compare_cs
+
+!*******************************************************************************
+!     ==
+!*******************************************************************************
+! string == string
+
+      elemental function s_eq_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_eq_s
+      integer                   :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      if (l1 > l2) then
+          s_eq_s = all(s1%chars(1:l2) == s2%chars) .and.  &
+                   all(s1%chars(l2+1:l1) == blank)
+      elseif (l1 < l2) then
+          s_eq_s = all(s1%chars == s2%chars(1:l1)) .and.  &
+                   all(blank == s2%chars(l1+1:l2))
+      else
+          s_eq_s = all(s1%chars == s2%chars)
+      endif
+
+      end function s_eq_s
+
+!*******************************************************************************
+! string == character
+
+      elemental function s_eq_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_eq_c
+      integer                   :: i,ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      do i=1,min(ls,lc)
+          if (s%chars(i) /= c(i:i)) then
+              s_eq_c = .false.
+              return
+          endif
+      enddo
+      if ((ls > lc) .and. any(s%chars(lc+1:ls) /= blank)) then
+          s_eq_c = .false.
+      elseif ((ls < lc) .and. (blank /= c(ls+1:lc))) then
+          s_eq_c = .false.
+      else
+          s_eq_c = .true.
+      endif
+
+      end function s_eq_c
+
+!*******************************************************************************
+! character == string
+
+      elemental function c_eq_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_eq_s
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) /= s%chars(i)) then
+              c_eq_s = .false.
+              return
+          endif
+      enddo
+      if ((lc > ls) .and. (c(ls+1:lc) /= blank)) then
+          c_eq_s = .false.
+      elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls) ) )then
+          c_eq_s = .false.
+      else
+          c_eq_s = .true.
+      endif
+
+      end function c_eq_s
+
+!*******************************************************************************
+!     /=
+!*******************************************************************************
+! string /= string
+
+      elemental function s_ne_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_ne_s
+      integer                   :: l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      if (l1 > l2) then
+          s_ne_s = any(s1%chars(1:l2) /= s2%chars) .or.  &
+                   any(s1%chars(l2+1:l1) /= blank)
+      elseif (l1 < l2) then
+          s_ne_s = any(s1%chars /= s2%chars(1:l1)) .or. &
+                   any(blank /= s2%chars(l1+1:l2))
+      else
+          s_ne_s = any(s1%chars /= s2%chars)
+      endif
+
+      end function s_ne_s
+
+!*******************************************************************************
+! string /= character
+
+      elemental function s_ne_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_ne_c
+      integer                   :: i,ls,lc
+
+
+      ls = len(s)
+      lc = len(c)
+      do i=1,min(ls,lc)
+          if (s%chars(i) /= c(i:i) )then
+              s_ne_c = .true.
+              return
+          endif
+      enddo
+      if ((ls > lc) .and. any(s%chars(ls+1:lc) /= blank)) then
+          s_ne_c = .true.
+      elseif ((ls < lc) .and. blank /= c(ls+1:lc)) then
+          s_ne_c = .true.
+      else
+          s_ne_c = .false.
+      endif
+
+      end function s_ne_c
+
+!*******************************************************************************
+! character /= string
+
+      elemental function c_ne_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_ne_s
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (c(i:i) /= s%chars(i)) then
+              c_ne_s = .true.
+              return
+          endif
+      enddo
+      if ((lc > ls) .and. c(ls+1:lc) /= blank) then
+          c_ne_s = .true.
+      elseif ((lc < ls) .and. any(blank /= s%chars(lc+1:ls))) then
+          c_ne_s = .true.
+      else
+          c_ne_s = .false.
+      endif
+
+      end function c_ne_s
+
+!*******************************************************************************
+!     < operators
+!*******************************************************************************
+! string < string
+
+      elemental function s_lt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lt_s
+
+
+      s_lt_s = compare_ss(s1,s2) == 'LT'
+
+      end function s_lt_s
+
+!*******************************************************************************
+! string < character
+
+      elemental function s_lt_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_lt_c
+
+
+      s_lt_c = compare_cs(c,s) == 'GT'
+
+      end function s_lt_c
+
+!*******************************************************************************
+! character < string
+
+      elemental function c_lt_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_lt_s
+
+
+      c_lt_s = compare_cs(c,s) == 'LT'
+
+      end function c_lt_s
+
+!*******************************************************************************
+!     <=  operators
+!*******************************************************************************
+! string <= string
+
+      elemental function s_le_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_le_s
+
+
+      s_le_s = compare_ss(s1,s2) /= 'GT'
+
+      end function s_le_s
+
+!*******************************************************************************
+! string <= character
+
+      elemental function s_le_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_le_c
+
+
+      s_le_c = compare_cs(c,s) /= 'LT'
+
+      end function s_le_c
+
+!*******************************************************************************
+! character <= string
+
+      elemental function c_le_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_le_s
+
+
+      c_le_s = compare_cs(c,s) /= 'GT'
+
+      end function c_le_s
+
+!*******************************************************************************
+!     >=  operators
+!*******************************************************************************
+! string >= string
+
+      elemental function s_ge_s(s1,s2)
+
+      implicit none
+      type(string), intent(in) :: s1,s2
+      logical                  :: s_ge_s
+
+
+      s_ge_s = compare_ss(s1,s2) /= 'LT'
+
+      end function s_ge_s
+
+!*******************************************************************************
+! string >= character
+
+      elemental function s_ge_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_ge_c
+
+
+      s_ge_c = compare_cs(c,s) /= 'GT'
+
+      end function s_ge_c
+
+!*******************************************************************************
+! character >= string
+
+      elemental function c_ge_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_ge_s
+
+
+      c_ge_s = compare_cs(c,s) /= 'LT'
+
+      end function c_ge_s
+
+!*******************************************************************************
+!     >  operators
+!*******************************************************************************
+! string > string
+
+      elemental function s_gt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in) :: s1,s2
+      logical                  :: s_gt_s
+
+
+      s_gt_s = compare_ss(s1,s2) == 'GT'
+
+      end function s_gt_s
+
+!*******************************************************************************
+! string > character
+
+      elemental function s_gt_c(s,c)
+
+      implicit none
+      type(string), intent(in)  :: s
+      character(*), intent(in)  :: c
+      logical                   :: s_gt_c
+
+
+      s_gt_c = compare_cs(c,s) == 'LT'
+
+      end function s_gt_c
+
+!*******************************************************************************
+! character > string
+
+      elemental function c_gt_s(c,s)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      logical                   :: c_gt_s
+
+
+      c_gt_s = compare_cs(c,s) == 'GT'
+
+      end function c_gt_s
+
+!*******************************************************************************
+
+      elemental function lcompare_ss(s1,s2) result(css)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      character(2)              :: css
+      integer                   :: i,l1,l2
+
+
+      l1 = len(s1)
+      l2 = len(s2)
+      do i=1,min(l1,l2)
+          if (llt(s1%chars(i),s2%chars(i))) then
+              css = 'LT'
+              return
+          elseif (lgt(s1%chars(i),s2%chars(i))) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (llt(blank,s2%chars(i))) then
+                  css = 'LT'
+                  return
+              elseif (lgt(blank,s2%chars(i))) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (llt(s1%chars(i),blank)) then
+                  css = 'LT'
+                  return
+              elseif (lgt(s1%chars(i),blank)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function lcompare_ss
+
+!*******************************************************************************
+
+      elemental function lcompare_cs(c,s) result(css)
+
+      implicit none
+      character(*), intent(in)  :: c
+      type(string), intent(in)  :: s
+      character(2)              :: css
+      integer                   :: i,lc,ls
+
+
+      lc = len(c)
+      ls = len(s)
+      do i=1,min(lc,ls)
+          if (llt(c(i:i),s%chars(i))) then
+              css = 'LT'
+              return
+          elseif (lgt(c(i:i),s%chars(i))) then
+              css = 'GT'
+              return
+          endif
+      enddo
+      if (lc < ls) then
+          do i=lc+1,ls
+              if (llt(blank,s%chars(i))) then
+                  css = 'LT'
+                  return
+              elseif (lgt(blank,s%chars(i))) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > ls) then
+          do i=ls+1,lc
+              if (llt(c(i:i),blank)) then
+                  css = 'LT'
+                  return
+              elseif (lgt(c(i:i),blank)) then
+                  css = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      css = 'EQ'
+
+      end function lcompare_cs
+
+!*******************************************************************************
+!     LLT function
+!*******************************************************************************
+!     llt(string,string)
+
+      elemental function s_llt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_llt_s
+
+      s_llt_s = (lcompare_ss(s1,s2) == 'LT')
+
+      end function s_llt_s
+
+!*******************************************************************************
+!     llt(string,character)
+
+      elemental function s_llt_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_llt_c
+
+      s_llt_c = (lcompare_cs(c2,s1) == 'GT')
+
+      end function s_llt_c
+
+!*******************************************************************************
+!     llt(character,string)
+
+      elemental function c_llt_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_llt_s
+
+      c_llt_s = (lcompare_cs(c1,s2) == 'LT')
+
+      end function c_llt_s
+
+!*******************************************************************************
+!     LGT function
+!*******************************************************************************
+!     lgt(string,string)
+
+      elemental function s_lgt_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lgt_s
+
+      s_lgt_s = (lcompare_ss(s1,s2) == 'GT')
+
+      end function s_lgt_s
+
+!*******************************************************************************
+!     lgt(string,character)
+
+      elemental function s_lgt_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lgt_c
+
+      s_lgt_c = (lcompare_cs(c2,s1) == 'LT')
+
+      end function s_lgt_c
+
+!*******************************************************************************
+!     lgt(character,string)
+
+      elemental function c_lgt_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lgt_s
+
+      c_lgt_s = (lcompare_cs(c1,s2) == 'GT')
+
+      end function c_lgt_s
+
+!*******************************************************************************
+!     LGE function
+!*******************************************************************************
+!     lge(string,string)
+
+      elemental function s_lge_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lge_s
+
+      s_lge_s = (lcompare_ss(s1,s2) /= 'LT')
+
+      end function s_lge_s
+
+!*******************************************************************************
+!     lge(string,character)
+
+      elemental function s_lge_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lge_c
+
+      s_lge_c = (lcompare_cs(c2,s1) /= 'GT')
+
+      end function s_lge_c
+
+!*******************************************************************************
+!     lge(character,string)
+
+      elemental function c_lge_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lge_s
+
+      c_lge_s = (lcompare_cs(c1,s2) /= 'LT')
+
+      end function c_lge_s
+
+!*******************************************************************************
+!     LLE function
+!*******************************************************************************
+!     lle(string,string)
+
+      elemental function s_lle_s(s1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s1,s2
+      logical                   :: s_lle_s
+
+      s_lle_s = (lcompare_ss(s1,s2) /= 'GT')
+
+      end function s_lle_s
+
+!*******************************************************************************
+!     lle(string,character)
+
+      elemental function s_lle_c(s1,c2)
+
+      implicit none
+      type(string), intent(in)  :: s1
+      character(*), intent(in)  :: c2
+      logical                   :: s_lle_c
+
+      s_lle_c = (lcompare_cs(c2,s1) /= 'LT')
+
+      end function s_lle_c
+
+!*******************************************************************************
+!     lle(character,string)
+
+      elemental function c_lle_s(c1,s2)
+
+      implicit none
+      type(string), intent(in)  :: s2
+      character(*), intent(in)  :: c1
+      logical                   :: c_lle_s
+
+      c_lle_s = (lcompare_cs(c1,s2) /= 'GT')
+
+      end function c_lle_s
+
+!*******************************************************************************
+
+      pure function acompare_aa(a1,a2) result(caa)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      character(2)           :: caa
+      integer                :: i,l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      do i=1,min(l1,l2)
+          if (a1(i) < a2(i)) then
+              caa = 'LT'
+              return
+          elseif (a1(i) > a2(i)) then
+              caa = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (blank < a2(i)) then
+                  caa = 'LT'
+                  return
+              elseif (blank > a2(i)) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (a1(i) < blank) then
+                  caa = 'LT'
+                  return
+              elseif (a1(i) > blank) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      caa = 'EQ'
+
+      end function acompare_aa
+
+!*******************************************************************************
+
+      pure function acompare_ca(c,a) result(cca)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      character(2)              :: cca
+      integer                   :: i,lc,la
+
+
+      lc = len(c)
+      la = size(a)
+      do i=1,min(lc,la)
+          if (c(i:i) < a(i)) then
+              cca = 'LT'
+              return
+          elseif (c(i:i) > a(i)) then
+              cca = 'GT'
+              return
+          endif
+      enddo
+      if (lc < la) then
+          do i=lc+1,la
+              if (blank < a(i)) then
+                  cca = 'LT'
+                  return
+              elseif (blank > a(i)) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > la) then
+          do i=la+1,lc
+              if (c(i:i) < blank) then
+                  cca = 'LT'
+                  return
+              elseif (c(i:i) > blank) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      cca = 'EQ'
+
+      end function acompare_ca
+
+!*******************************************************************************
+!     ==
+!*******************************************************************************
+! array == array
+
+      pure function a_eq_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_eq_a
+      integer                :: l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      if (l1 > l2) then
+          a_eq_a = all(a1(1:l2) == a2) .and.  &
+                   all(a1(l2+1:l1) == blank)
+      elseif (l1 < l2) then
+          a_eq_a = all(a1 == a2(1:l1)) .and.  &
+                   all(blank == a2(l1+1:l2))
+      else
+          a_eq_a = all(a1 == a2)
+      endif
+
+      end function a_eq_a
+
+!*******************************************************************************
+! array == character
+
+      pure function a_eq_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_eq_c
+      integer                   :: i,la,lc
+
+
+      la = len(a)
+      lc = len(c)
+      do i=1,min(la,lc)
+          if (a(i) /= c(i:i)) then
+              a_eq_c = .false.
+              return
+          endif
+      enddo
+      if ((la > lc) .and. any(a(lc+1:la) /= blank)) then
+          a_eq_c = .false.
+      elseif ((la < lc) .and. (blank /= c(la+1:lc))) then
+          a_eq_c = .false.
+      else
+          a_eq_c = .true.
+      endif
+
+      end function a_eq_c
+
+!*******************************************************************************
+! character == array
+
+      pure function c_eq_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_eq_a
+
+
+      c_eq_a = a_eq_c(a,c)
+
+      end function c_eq_a
+
+!*******************************************************************************
+!     /=
+!*******************************************************************************
+! array /= array
+
+      pure function a_ne_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_ne_a
+      integer                :: l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      if (l1 > l2) then
+          a_ne_a = any(a1(1:l2) /= a2) .or.  &
+                   any(a1(l2+1:l1) /= blank)
+      elseif (l1 < l2) then
+          a_ne_a = any(a1 /= a2(1:l1)) .or. &
+                   any(blank /= a2(l1+1:l2))
+      else
+          a_ne_a = any(a1 /= a2)
+      endif
+
+      end function a_ne_a
+
+!*******************************************************************************
+! array /= character
+
+      pure function a_ne_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_ne_c
+      integer                   :: i,la,lc
+
+
+      la = size(a)
+      lc = len(c)
+      do i=1,min(la,lc)
+          if (a(i) /= c(i:i) )then
+              a_ne_c = .true.
+              return
+          endif
+      enddo
+      if ((la > lc) .and. any(a(la+1:lc) /= blank)) then
+          a_ne_c = .true.
+      elseif ((la < lc) .and. blank /= c(la+1:lc)) then
+          a_ne_c = .true.
+      else
+          a_ne_c = .false.
+      endif
+
+      end function a_ne_c
+
+!*******************************************************************************
+! character /= array
+
+      pure function c_ne_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_ne_a
+
+
+      c_ne_a = acompare_ca(c,a) /= 'EQ'
+
+      end function c_ne_a
+
+!*******************************************************************************
+!     < operators
+!*******************************************************************************
+! array < array
+
+      pure function a_lt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_lt_a
+
+
+      a_lt_a = acompare_aa(a1,a2) == 'LT'
+
+      end function a_lt_a
+
+!*******************************************************************************
+! array < character
+
+      pure function a_lt_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_lt_c
+
+
+      a_lt_c = acompare_ca(c,a) == 'GT'
+
+      end function a_lt_c
+
+!*******************************************************************************
+! character < array
+
+      pure function c_lt_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_lt_a
+
+
+      c_lt_a = acompare_ca(c,a) == 'LT'
+
+      end function c_lt_a
+
+!*******************************************************************************
+!     <=  operators
+!*******************************************************************************
+! array <= array
+
+      pure function a_le_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_le_a
+
+
+      a_le_a = acompare_aa(a1,a2) /= 'GT'
+
+      end function a_le_a
+
+!*******************************************************************************
+! array <= character
+
+      pure function a_le_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_le_c
+
+
+      a_le_c = acompare_ca(c,a) /= 'LT'
+
+      end function a_le_c
+
+!*******************************************************************************
+! character <= array
+
+      pure function c_le_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_le_a
+
+
+      c_le_a = acompare_ca(c,a) /= 'GT'
+
+      end function c_le_a
+
+!*******************************************************************************
+!     >=  operators
+!*******************************************************************************
+! array >= array
+
+      pure function a_ge_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_ge_a
+
+
+      a_ge_a = acompare_aa(a1,a2) /= 'LT'
+
+      end function a_ge_a
+
+!*******************************************************************************
+! array >= character
+
+      pure function a_ge_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_ge_c
+
+
+      a_ge_c = acompare_ca(c,a) /= 'GT'
+
+      end function a_ge_c
+
+!*******************************************************************************
+! character >= array
+
+      pure function c_ge_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_ge_a
+
+
+      c_ge_a = acompare_ca(c,a) /= 'LT'
+
+      end function c_ge_a
+
+!*******************************************************************************
+!     >  operators
+!*******************************************************************************
+! array > array
+
+      pure function a_gt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_gt_a
+
+
+      a_gt_a = acompare_aa(a1,a2) == 'GT'
+
+      end function a_gt_a
+
+!*******************************************************************************
+! array > character
+
+      pure function a_gt_c(a,c)
+
+      implicit none
+      character, intent(in)     :: a(:)
+      character(*), intent(in)  :: c
+      logical                   :: a_gt_c
+
+
+      a_gt_c = acompare_ca(c,a) == 'LT'
+
+      end function a_gt_c
+
+!*******************************************************************************
+! character > array
+
+      pure function c_gt_a(c,a)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      logical                   :: c_gt_a
+
+
+      c_gt_a = acompare_ca(c,a) == 'GT'
+
+      end function c_gt_a
+
+!*******************************************************************************
+
+      pure function alcompare_aa(a1,a2) result(caa)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      character(2)           :: caa
+      integer                :: i,l1,l2
+
+
+      l1 = size(a1)
+      l2 = size(a2)
+      do i=1,min(l1,l2)
+          if (llt(a1(i),a2(i))) then
+              caa = 'LT'
+              return
+          elseif (lgt(a1(i),a2(i))) then
+              caa = 'GT'
+              return
+          endif
+      enddo
+      if (l1 < l2) then
+          do i=l1+1,l2
+              if (llt(blank,a2(i))) then
+                  caa = 'LT'
+                  return
+              elseif (lgt(blank,a2(i))) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      elseif (l1 > l2) then
+          do i=l2+1,l1
+              if (llt(a1(i),blank)) then
+                  caa = 'LT'
+                  return
+              elseif (lgt(a1(i),blank)) then
+                  caa = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      caa = 'EQ'
+
+      end function alcompare_aa
+
+!*******************************************************************************
+
+      pure function alcompare_ca(c,a) result(cca)
+
+      implicit none
+      character(*), intent(in)  :: c
+      character, intent(in)     :: a(:)
+      character(2)              :: cca
+      integer                   :: i,lc,la
+
+
+      lc = len(c)
+      la = size(a)
+      do i=1,min(lc,la)
+          if (llt(c(i:i),a(i))) then
+              cca = 'LT'
+              return
+          elseif (lgt(c(i:i),a(i))) then
+              cca = 'GT'
+              return
+          endif
+      enddo
+      if (lc < la) then
+          do i=lc+1,la
+              if (llt(blank,a(i))) then
+                  cca = 'LT'
+                  return
+              elseif (lgt(blank,a(i))) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      elseif (lc > la) then
+          do i=la+1,lc
+              if (llt(c(i:i),blank)) then
+                  cca = 'LT'
+                  return
+              elseif (lgt(c(i:i),blank)) then
+                  cca = 'GT'
+                  return
+              endif
+          enddo
+      endif
+      cca = 'EQ'
+
+      end function alcompare_ca
+
+!*******************************************************************************
+!     LLT operators
+!*******************************************************************************
+! array < array
+
+      pure function a_allt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_allt_a
+
+
+      a_allt_a = alcompare_aa(a1,a2) == 'LT'
+
+      end function a_allt_a
+
+!*******************************************************************************
+! array < character
+
+      pure function a_allt_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_allt_c
+
+
+      a_allt_c = alcompare_ca(c2,a1) == 'GT'
+
+      end function a_allt_c
+
+!*******************************************************************************
+! character < array
+
+      pure function c_allt_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_allt_a
+
+
+      c_allt_a = alcompare_ca(c1,a2) == 'LT'
+
+      end function c_allt_a
+
+!*******************************************************************************
+!     LLE  operators
+!*******************************************************************************
+! array <= array
+
+      pure function a_alle_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_alle_a
+
+
+      a_alle_a = alcompare_aa(a1,a2) /= 'GT'
+
+      end function a_alle_a
+
+!*******************************************************************************
+! array <= character
+
+      pure function a_alle_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_alle_c
+
+
+      a_alle_c = alcompare_ca(c2,a1) /= 'LT'
+
+      end function a_alle_c
+
+!*******************************************************************************
+! character <= array
+
+      pure function c_alle_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_alle_a
+
+
+      c_alle_a = alcompare_ca(c1,a2) /= 'GT'
+
+      end function c_alle_a
+
+!*******************************************************************************
+!     LGE  operators
+!*******************************************************************************
+! array >= array
+
+      pure function a_alge_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_alge_a
+
+
+      a_alge_a = alcompare_aa(a1,a2) /= 'LT'
+
+      end function a_alge_a
+
+!*******************************************************************************
+! array >= character
+
+      pure function a_alge_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_alge_c
+
+
+      a_alge_c = alcompare_ca(c2,a1) /= 'GT'
+
+      end function a_alge_c
+
+!*******************************************************************************
+! character >= array
+
+      pure function c_alge_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_alge_a
+
+
+      c_alge_a = alcompare_ca(c1,a2) /= 'LT'
+
+      end function c_alge_a
+
+!*******************************************************************************
+!     LGT  operators
+!*******************************************************************************
+! array > array
+
+      pure function a_algt_a(a1,a2)
+
+      implicit none
+      character, intent(in)  :: a1(:),a2(:)
+      logical                :: a_algt_a
+
+
+      a_algt_a = alcompare_aa(a1,a2) == 'GT'
+
+      end function a_algt_a
+
+!*******************************************************************************
+! array > character
+
+      pure function a_algt_c(a1,c2)
+
+      implicit none
+      character, intent(in)     :: a1(:)
+      character(*), intent(in)  :: c2
+      logical                   :: a_algt_c
+
+
+      a_algt_c = alcompare_ca(c2,a1) == 'LT'
+
+      end function a_algt_c
+
+!*******************************************************************************
+! character > array
+
+      pure function c_algt_a(c1,a2)
+
+      implicit none
+      character(*), intent(in)  :: c1
+      character, intent(in)     :: a2(:)
+      logical                   :: c_algt_a
+
+
+      c_algt_a = alcompare_ca(c1,a2) == 'GT'
+
+      end function c_algt_a
+
+!*******************************************************************************
+!     INDEX
+!*******************************************************************************
+
+      elemental function index_ss(s,sub,back)
+
+      implicit none
+      type(string), intent(in)       :: s,sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lsub
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lsub = len(sub)
+      index_ss = aindex(s%chars(:ls),sub%chars(:lsub),dir_switch)
+
+      end function index_ss
+
+!*******************************************************************************
+
+      elemental function index_sc(s,sub,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      index_sc = aindex(s%chars(:ls),sub,dir_switch)
+
+      end function index_sc
+
+!*******************************************************************************
+
+      elemental function index_cs(s,sub,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_cs
+      logical                        :: dir_switch
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      index_cs = index(s,char(sub),dir_switch)
+
+      end function index_cs
+
+!*******************************************************************************
+!     AINDEX
+!*******************************************************************************
+
+      pure function aindex_aa(s,sub,back) result(index_aa)
+
+      implicit none
+      character, intent(in)          :: s(:),sub(:)
+      logical, intent(in), optional  :: back
+      integer                        :: index_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lss = size(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_aa = ls + 1
+          else
+              index_aa = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+!         backwards search
+          do i=ls-lss+1,1,-1
+              if (all(s(i:i+lss-1) == sub(1:lss))) then
+                  index_aa = i
+                  return
+              endif
+          enddo
+          index_aa = 0
+      else
+!         forward search
+          do i=1,ls-lss+1
+              if (all(s(i:i+lss-1) == sub(1:lss))) then
+                  index_aa = i
+                  return
+              endif
+          enddo
+          index_aa = 0
+      endif
+
+      end function aindex_aa
+
+!*******************************************************************************
+
+      pure function aindex_ac(s,sub,back) result(index_ac)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: sub
+      logical, intent(in), optional  :: back
+      integer                        :: index_ac
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lss = len(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_ac = ls + 1
+          else
+              index_ac = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+          index_ac = 0
+          do i=ls-lss+1,1,-1
+              matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+              if (matched) then
+                  index_ac = i
+                  return
+              endif
+          enddo
+      else
+          index_ac = 0
+          do i=1,ls-lss+1
+              matched = all(s(i:i+lss-1) == (/ (sub(j:j), j=1,lss) /))
+              if (matched) then
+                  index_ac = i
+                  return
+              endif
+          enddo
+      endif
+
+      end function aindex_ac
+
+!*******************************************************************************
+
+      pure function aindex_ca(s,sub,back) result(index_ca)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: sub(:)
+      logical, intent(in), optional  :: back
+      integer                        :: index_ca
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lss
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lss = size(sub)
+
+      if (lss == 0) then
+          if (dir_switch) then
+              index_ca = ls + 1
+          else
+              index_ca = 1
+          endif
+          return
+      endif
+
+      if (dir_switch) then
+          do i=ls-lss+1,1,-1
+              matched = .true.
+              do j=1,lss
+                  if (s(i+j-1:i+j-1) /= sub(j)) then
+                      matched = .false.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  index_ca = i
+                  return
+              endif
+          enddo
+          index_ca = 0
+      else
+          do i=1,ls-lss+1
+              matched = .true.
+              do j=1,lss
+                  if (s(i+j-1:i+j-1) /= sub(j)) then
+                      matched = .false.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  index_ca = i
+                  return
+              endif
+          enddo
+          index_ca = 0
+      endif
+
+      end function aindex_ca
+
+!*******************************************************************************
+!     SCAN
+!*******************************************************************************
+
+      elemental function scan_ss(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s,set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = len(set)
+      scan_ss = ascan_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+      end function scan_ss
+
+!*******************************************************************************
+
+      elemental function scan_sc(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      scan_sc = ascan_ac(s%chars(1:ls),set,dir_switch)
+
+      end function scan_sc
+
+!*******************************************************************************
+
+      elemental function scan_cs(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: scan_cs
+      logical                        :: dir_switch
+      integer                        :: lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      lset = len(set)
+      scan_cs = ascan_ca(s,set%chars(1:lset),dir_switch)
+
+      end function scan_cs
+!*******************************************************************************
+!     ASCAN
+!*******************************************************************************
+
+      pure function ascan_aa(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:),set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              if (any(set(1:lset) == s(i))) then
+                  ascan_aa = i
+                  return
+              endif
+          enddo
+          ascan_aa = 0
+      else
+!         forward search
+          do i=1,ls
+              if (any(set(1:lset) == s(i))) then
+                  ascan_aa = i
+                  return
+              endif
+          enddo
+          ascan_aa = 0
+      endif
+
+      end function ascan_aa
+
+!*******************************************************************************
+
+      pure function ascan_ac(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_ac
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = len(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              matched = .false.
+              do j=1,lset
+                  if (s(i) == set(j:j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ac = i
+                  return
+              endif
+          enddo
+          ascan_ac = 0
+      else
+!         forward search
+          do i=1,ls
+              matched = .false.
+              do j=1,lset
+                  if (s(i) == set(j:j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ac = i
+                  return
+              endif
+          enddo
+          ascan_ac = 0
+      endif
+
+      end function ascan_ac
+
+!*******************************************************************************
+
+      pure function ascan_ca(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: ascan_ca
+      logical                        :: dir_switch,matched
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              matched = .false.
+              do j=1,lset
+                  if (s(i:i) == set(j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ca = i
+                  return
+              endif
+          enddo
+          ascan_ca = 0
+      else
+!         forward search
+          do i=1,ls
+              matched = .false.
+              do j=1,lset
+                  if (s(i:i) == set(j)) then
+                      matched = .true.
+                      exit
+                  endif
+              enddo
+              if (matched) then
+                  ascan_ca = i
+                  return
+              endif
+          enddo
+          ascan_ca = 0
+      endif
+
+      end function ascan_ca
+
+!*******************************************************************************
+!     VERIFY
+!*******************************************************************************
+
+      elemental function verify_ss(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s,set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_ss
+      logical                        :: dir_switch
+      integer                        :: ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = len(set)
+      verify_ss = averify_aa(s%chars(1:ls),set%chars(1:lset),dir_switch)
+
+      end function verify_ss
+
+!*******************************************************************************
+
+      elemental function verify_sc(s,set,back)
+
+      implicit none
+      type(string), intent(in)       :: s
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_sc
+      logical                        :: dir_switch
+      integer                        :: ls
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      verify_sc = averify_ac(s%chars(1:ls),set,dir_switch)
+
+      end function verify_sc
+
+!*******************************************************************************
+
+      elemental function verify_cs(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      type(string), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: verify_cs
+      logical                        :: dir_switch
+      integer                        :: lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      lset = len(set)
+      verify_cs = averify_ca(s,set%chars(1:lset),dir_switch)
+
+      end function verify_cs
+
+!*******************************************************************************
+!     AVERIFY
+!*******************************************************************************
+
+      pure function averify_aa(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:),set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: averify_aa
+      logical                        :: dir_switch
+      integer                        :: i,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+          do i=ls,1,-1
+              if (.not.(any(set(1:lset) == s(i)))) then
+                  averify_aa = i
+                  return
+              endif
+          enddo
+          averify_aa = 0
+      else
+!         forward search
+          do i=1,ls
+              if (.not.(any(set(1:lset) == s(i)))) then
+                  averify_aa = i
+                  return
+              endif
+          enddo
+          averify_aa = 0
+      endif
+
+      end function averify_aa
+
+!*******************************************************************************
+
+      pure function averify_ac(s,set,back)
+
+      implicit none
+      character, intent(in)          :: s(:)
+      character(*), intent(in)       :: set
+      logical, intent(in), optional  :: back
+      integer                        :: averify_ac
+      logical                        :: dir_switch
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = size(s)
+      lset = len(set)
+      if (dir_switch) then
+!         backwards search
+b:        do i=ls,1,-1
+              do j=1,lset
+                  if (s(i) == set(j:j)) cycle b
+              enddo
+              averify_ac = i
+              return
+          enddo b
+          averify_ac = 0
+      else
+!         forward search
+f:        do i=1,ls
+              do j=1,lset
+                  if (s(i) == set(j:j)) cycle f
+              enddo
+              averify_ac = i
+              return
+          enddo f
+          averify_ac = 0
+      endif
+
+      end function averify_ac
+
+!*******************************************************************************
+
+      pure function averify_ca(s,set,back)
+
+      implicit none
+      character(*), intent(in)       :: s
+      character, intent(in)          :: set(:)
+      logical, intent(in), optional  :: back
+      integer                        :: averify_ca
+      logical                        :: dir_switch
+      integer                        :: i,j,ls,lset
+
+
+      if (present(back)) then
+          dir_switch = back
+      else
+          dir_switch = .false.
+      endif
+
+      ls = len(s)
+      lset = size(set)
+      if (dir_switch) then
+!         backwards search
+b:        do i=ls,1,-1
+              do j=1,lset
+                  if (s(i:i) == set(j)) cycle b
+              enddo
+              averify_ca = i
+              return
+          enddo b
+          averify_ca = 0
+      else
+!         forward search
+f:        do i=1,ls
+              do j=1,lset
+                  if (s(i:i) == set(j)) cycle f
+              enddo
+              averify_ca = i
+              return
+          enddo f
+          averify_ca = 0
+      endif
+
+      end function averify_ca
+
+!*******************************************************************************
+!     UPPERCASE
+!*******************************************************************************
+
+      pure function uppercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(in)       :: s
+      integer, intent(in), optional  :: begin,end
+      character(len(s))              :: uppercase_s
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=1,i1-1
+          uppercase_s(i:i) = s%chars(i)
+      enddo
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(97:122)
+              uppercase_s(i:i) = achar(j-32)
+          case default
+              uppercase_s(1:i) = s%chars(i)
+          end select
+      enddo
+      do i=i2+1,len(s)
+          uppercase_s(i:i) = s%chars(i)
+      enddo
+
+      end function uppercase_s
+
+!*******************************************************************************
+
+      pure function uppercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(in)       :: c
+      integer, intent(in), optional  :: begin,end
+      character(len(c))              :: uppercase_c
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      uppercase_c(:i1-1) = c(:i1-1)
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(97:122)
+              uppercase_c(i:i) = achar(j-32)
+          case default
+              uppercase_c(i:i) = c(i:i)
+          end select
+      enddo
+      uppercase_c(i2+1:) = c(i2+1:)
+
+      end function uppercase_c
+
+!*******************************************************************************
+
+      elemental subroutine to_uppercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(inout)    :: s
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(97:122)
+              s%chars(i) = achar(j-32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_uppercase_s
+
+!*******************************************************************************
+
+      elemental subroutine to_uppercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(inout)    :: c
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(97:122)
+              c(i:i) = achar(j-32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_uppercase_c
+
+!*******************************************************************************
+!     LOWERCASE
+!*******************************************************************************
+
+      pure function lowercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(in)       :: s
+      integer, intent(in), optional  :: begin,end
+      character(len(s))              :: lowercase_s
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=1,i1-1
+          lowercase_s(i:i) = s%chars(i)
+      enddo
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(65:90)
+              lowercase_s(i:i) = achar(j+32)
+          case default
+              lowercase_s(i:i) = s%chars(i)
+          end select
+      enddo
+      do i=i2+1,len(s)
+          lowercase_s(i:i) = s%chars(i)
+      enddo
+
+      end function lowercase_s
+
+!*******************************************************************************
+
+      pure function lowercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(in)       :: c
+      integer, intent(in), optional  :: begin,end
+      character(len(c))              :: lowercase_c
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      lowercase_c(:i1-1) = c(:i1-1)
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(65:90)
+              lowercase_c(i:i) = achar(j+32)
+          case default
+              lowercase_c(i:i) = c(i:i)
+          end select
+      enddo
+      lowercase_c(i2+1:) = c(i2+1:)
+
+      end function lowercase_c
+
+!*******************************************************************************
+
+      elemental subroutine to_lowercase_s(s,begin,end)
+
+      implicit none
+      type(string), intent(inout)    :: s
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(s)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(s%chars(i))
+          select case(j)
+          case(65:90)
+              s%chars(i) = achar(j+32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_lowercase_s
+
+!*******************************************************************************
+
+      elemental subroutine to_lowercase_c(c,begin,end)
+
+      implicit none
+      character(*), intent(inout)    :: c
+      integer, intent(in), optional  :: begin,end
+      integer                        :: i,i1,i2,j
+
+
+      i1 = 1
+      if (present(begin)) i1 = max(i1,begin)
+      i2 = len(c)
+      if (present(end)) i2 = min(i2,end)
+
+      do i=i1,i2
+          j = iachar(c(i:i))
+          select case(j)
+          case(65:90)
+              c(i:i) = achar(j+32)
+          case default
+              continue
+          end select
+      enddo
+
+      end subroutine to_lowercase_c
+
+!*******************************************************************************
+
+!*******************************************************************************
+
+      end module m_strings
Index: /OBSOLETE/XMLF90/src/wxml/flib_wxml.f90
===================================================================
--- /OBSOLETE/XMLF90/src/wxml/flib_wxml.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/wxml/flib_wxml.f90	(revision 2354)
@@ -0,0 +1,11 @@
+module flib_wxml
+
+!use m_wxml_buffer
+!use m_wxml_dictionary
+!use m_wxml_elstack
+use m_wxml_text
+use m_wxml_core
+
+public
+
+end module flib_wxml
Index: /OBSOLETE/XMLF90/src/wxml/m_wxml_buffer.f90
===================================================================
--- /OBSOLETE/XMLF90/src/wxml/m_wxml_buffer.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/wxml/m_wxml_buffer.f90	(revision 2354)
@@ -0,0 +1,176 @@
+module m_wxml_buffer
+
+!
+! At this point we use a fixed-size buffer. 
+! Note however that buffer overflows will only be
+! triggered by overly long *unbroken* pcdata values, or
+! by overly long attribute values. Hopefully
+! element or attribute names are "short enough".
+! There is code in the parser module  m_fsm to avoid buffer overflows
+! caused by pcdata values.
+!
+! This module is re-used from the parser package.
+! Most of the routines are superfluous at this point.
+!
+! In a forthcoming implementation it could be made dynamical...
+!
+integer, parameter, public   :: MAX_BUFF_SIZE  = 2000
+integer, parameter, private  :: BUFF_SIZE_WARNING  = 1750
+!
+type, public  :: buffer_t
+private
+      integer                       :: size
+      character(len=MAX_BUFF_SIZE)  :: str
+end type buffer_t
+
+public :: add_to_buffer
+public :: print_buffer, str, char, len
+public :: operator (.equal.)
+public :: buffer_nearly_full, reset_buffer
+
+
+!----------------------------------------------------------------
+interface add_to_buffer
+      module procedure add_str_to_buffer
+end interface
+private :: add_char_to_buffer, add_str_to_buffer
+
+interface operator (.equal.)
+      module procedure compare_buffers, compare_buffer_str, &
+             compare_str_buffer
+end interface
+private :: compare_buffers, compare_buffer_str, compare_str_buffer
+
+interface str
+      module procedure buffer_to_str
+end interface
+interface char                 ! Experimental
+      module procedure buffer_to_str
+end interface
+private :: buffer_to_str
+
+interface len
+   module procedure buffer_length
+end interface
+private :: buffer_length
+
+CONTAINS
+!==================================================================
+
+!----------------------------------------------------------------
+function compare_buffers(a,b) result(equal)     ! .equal. generic
+type(buffer_t), intent(in)  :: a
+type(buffer_t), intent(in)  :: b
+logical                     :: equal
+
+equal = ((a%size == b%size) .and. (a%str(1:a%size) == b%str(1:b%size)))
+
+end function compare_buffers
+
+!----------------------------------------------------------------
+function compare_buffer_str(buffer,str) result(equal) ! .equal. generic
+type(buffer_t), intent(in)   :: buffer
+character(len=*), intent(in) :: str
+logical                      :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_buffer_str
+
+!----------------------------------------------------------------
+function compare_str_buffer(str,buffer) result(equal) ! .equal. generic
+character(len=*), intent(in) :: str
+type(buffer_t), intent(in)   :: buffer
+logical                     :: equal
+
+equal = (buffer%str(1:buffer%size) == trim(str))
+
+end function compare_str_buffer
+
+!----------------------------------------------------------------
+subroutine add_char_to_buffer(c,buffer)
+character(len=1), intent(in)   :: c
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n
+buffer%size = buffer%size + 1
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+!  RETURN
+!
+endif
+
+buffer%str(n:n) = c
+end subroutine add_char_to_buffer
+
+!----------------------------------------------------------------
+subroutine add_str_to_buffer(s,buffer)
+character(len=*), intent(in)   :: s
+type(buffer_t), intent(inout)  :: buffer
+
+integer   :: n, len_s, last_pos
+
+len_s = len(s)
+last_pos = buffer%size
+buffer%size = buffer%size + len_s
+n = buffer%size
+
+if (n> MAX_BUFF_SIZE) then
+  stop "wxml Buffer overflow: long unbroken string of pcdata or attribute value..."
+!  RETURN
+endif
+
+buffer%str(last_pos+1:n) = s
+end subroutine add_str_to_buffer
+
+!----------------------------------------------------------------
+subroutine reset_buffer(buffer)
+type(buffer_t), intent(inout)  :: buffer
+
+buffer%size = 0
+
+end subroutine reset_buffer
+
+!----------------------------------------------------------------
+subroutine print_buffer(buffer)
+type(buffer_t), intent(in)  :: buffer
+
+integer :: i
+
+do i = 1, buffer%size
+      write(unit=6,fmt="(a1)",advance="no") buffer%str(i:i)
+enddo
+
+end subroutine print_buffer
+!----------------------------------------------------------------
+! This is better... but could it lead to memory leaks?
+!
+function buffer_to_str(buffer) result(str)
+type(buffer_t), intent(in)          :: buffer
+character(len=buffer%size)          :: str
+
+str = buffer%str(1:buffer%size)
+end function buffer_to_str
+
+!----------------------------------------------------------------
+function buffer_nearly_full(buffer) result(warn)
+type(buffer_t), intent(in)          :: buffer
+logical                             :: warn
+
+warn = buffer%size > BUFF_SIZE_WARNING
+
+end function buffer_nearly_full
+
+!----------------------------------------------------------------
+function buffer_length(buffer) result(length)
+type(buffer_t), intent(in)          :: buffer
+integer                             :: length
+
+length = buffer%size 
+
+end function buffer_length
+
+
+end module m_wxml_buffer
Index: /OBSOLETE/XMLF90/src/wxml/m_wxml_core.f90
===================================================================
--- /OBSOLETE/XMLF90/src/wxml/m_wxml_core.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/wxml/m_wxml_core.f90	(revision 2354)
@@ -0,0 +1,380 @@
+module m_wxml_core
+
+use m_wxml_buffer
+use m_wxml_elstack
+use m_wxml_dictionary
+
+logical, private, save  :: pcdata_advance_line_default = .false.
+logical, private, save  :: pcdata_advance_space_default = .false.
+
+integer, private, parameter ::  sp = selected_real_kind(6,30)
+integer, private, parameter ::  dp = selected_real_kind(14,100)
+
+private
+
+type, public :: xmlf_t
+   integer            :: lun
+   type(buffer_t)     :: buffer
+   type(elstack_t)    :: stack
+   type(wxml_dictionary_t) :: dict
+   logical            :: start_tag_closed
+   logical            :: root_element_output
+   logical            :: indenting_requested
+end type xmlf_t
+
+public :: xml_OpenFile, xml_NewElement, xml_EndElement, xml_Close
+public :: xml_AddPcdata, xml_AddAttribute, xml_AddXMLDeclaration
+public :: xml_AddComment, xml_AddCdataSection
+
+public :: xml_AddArray
+interface xml_AddArray
+   module procedure  xml_AddArray_integer,  &
+                xml_AddArray_real_dp, xml_AddArray_real_sp
+end interface
+private :: xml_AddArray_integer,  xml_AddArray_real_dp, xml_AddArray_real_sp
+
+private :: get_unit
+private :: add_eol
+private :: write_attributes
+
+
+integer, private, parameter  :: COLUMNS = 80
+
+CONTAINS
+
+!-------------------------------------------------------------------
+subroutine xml_OpenFile(filename, xf, indent)
+character(len=*), intent(in)  :: filename
+type(xmlf_t), intent(inout)   :: xf
+logical, intent(in), optional :: indent
+
+integer :: iostat
+
+call get_unit(xf%lun,iostat)
+if (iostat /= 0) stop "cannot open file"
+open(unit=xf%lun, file=filename, form="formatted", status="replace", &
+     action="write", position="rewind") ! , recl=65536)
+
+call reset_elstack(xf%stack)
+call reset_dict(xf%dict)
+call reset_buffer(xf%buffer)
+
+xf%start_tag_closed = .true.
+xf%root_element_output = .false.
+
+xf%indenting_requested = .false.
+if (present(indent)) then
+   xf%indenting_requested = indent
+endif
+end subroutine xml_OpenFile
+
+!-------------------------------------------------------------------
+subroutine xml_AddXMLDeclaration(xf,encoding)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in), optional :: encoding
+
+if (present(encoding)) then
+   call add_to_buffer("<?xml version=""1.0"" encoding=""" &
+                     // trim(encoding) // """ ?>", xf%buffer)
+else
+   call add_to_buffer("<?xml version=""1.0"" ?>", xf%buffer)
+endif
+end subroutine xml_AddXMLDeclaration
+
+!-------------------------------------------------------------------
+subroutine xml_AddComment(xf,comment)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: comment
+
+call close_start_tag(xf,">")
+call add_eol(xf)
+call add_to_buffer("<!--", xf%buffer)
+call add_to_buffer(comment, xf%buffer)
+call add_to_buffer("-->", xf%buffer)
+end subroutine xml_AddComment
+
+!-------------------------------------------------------------------
+subroutine xml_AddCdataSection(xf,cdata)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: cdata
+
+call close_start_tag(xf,">")
+call add_to_buffer("<![CDATA[", xf%buffer)
+call add_to_buffer(cdata, xf%buffer)
+call add_to_buffer("]]>", xf%buffer)
+end subroutine xml_AddCdataSection
+
+!-------------------------------------------------------------------
+subroutine xml_NewElement(xf,name)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+
+if (is_empty(xf%stack)) then
+   if (xf%root_element_output) stop "two root elements"
+   xf%root_element_output = .true.
+endif
+
+call close_start_tag(xf,">")
+call push_elstack(name,xf%stack)
+call add_eol(xf)
+call add_to_buffer("<" // trim(name),xf%buffer)
+xf%start_tag_closed = .false.
+call reset_dict(xf%dict)
+
+end subroutine xml_NewElement
+!-------------------------------------------------------------------
+subroutine xml_AddPcdata(xf,pcdata,space,line_feed)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: pcdata
+logical, intent(in), optional  :: space
+logical, intent(in), optional  :: line_feed
+
+logical :: advance_line , advance_space
+integer :: n, i, jmax
+integer, parameter   :: chunk_size = 128
+
+advance_line = pcdata_advance_line_default 
+if (present(line_feed)) then
+   advance_line = line_feed
+endif
+
+advance_space = pcdata_advance_space_default 
+if (present(space)) then
+   advance_space = space
+endif
+
+if (is_empty(xf%stack)) then
+   stop "pcdata outside element content"
+endif
+
+call close_start_tag(xf,">")
+
+if (advance_line) then
+   call add_eol(xf)
+   advance_space = .false.
+else
+   if (xf%indenting_requested) then
+      if ((len(xf%buffer) + len_trim(pcdata) + 1) > COLUMNS ) then
+         call add_eol(xf)
+         advance_space = .false.
+      endif
+   endif
+endif
+if (advance_space) call add_to_buffer(" ",xf%buffer)
+if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.false.)
+!
+! We bypass the buffer for the bulk of the dump
+!
+n = len(pcdata)
+!print *, "writing pcdata of length: ", n
+i = 1
+do
+   jmax = min(i+chunk_size-1,n)
+!   print *, "writing chunk: ", i, jmax
+   write(unit=xf%lun,fmt="(a)",advance="no") pcdata(i:jmax)
+   if (jmax == n) exit
+   i = jmax + 1
+enddo
+end subroutine xml_AddPcdata
+
+!-------------------------------------------------------------------
+subroutine xml_AddAttribute(xf,name,value)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+character(len=*), intent(in)  :: value
+
+if (is_empty(xf%stack)) then
+   stop "attributes outside element content"
+endif
+
+if (xf%start_tag_closed)  then
+   stop "attributes outside start tag"
+endif
+if (has_key(xf%dict,name)) then
+   stop "duplicate att name"
+endif
+
+call add_key_to_dict(trim(name),xf%dict)
+call add_value_to_dict(trim(value),xf%dict)
+
+end subroutine xml_AddAttribute
+
+!-----------------------------------------------------------
+subroutine xml_EndElement(xf,name)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: name
+
+character(len=100)  :: current
+
+if (is_empty(xf%stack)) then
+   stop "Out of elements to close"
+endif
+
+call get_top_elstack(xf%stack,current)
+if (current /= name) then
+   print *, "current, name: ", trim(current), " ", trim(name)
+   stop
+endif
+if (.not. xf%start_tag_closed)  then                ! Empty element
+   if (len(xf%dict) > 0) call write_attributes(xf)
+   call add_to_buffer(" />",xf%buffer)
+   xf%start_tag_closed = .true.
+else
+   call add_eol(xf)
+   call add_to_buffer("</" // trim(name) // ">", xf%buffer)
+endif
+call pop_elstack(xf%stack,current)
+
+end subroutine xml_EndElement
+
+!----------------------------------------------------------------
+
+subroutine xml_Close(xf)
+type(xmlf_t), intent(in)   :: xf
+
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+close(unit=xf%lun)
+
+end subroutine xml_Close
+
+!==================================================================
+!-------------------------------------------------------------------
+subroutine get_unit(lun,iostat)
+
+! Get an available Fortran unit number
+
+integer, intent(out)  :: lun
+integer, intent(out)  :: iostat
+
+integer :: i
+logical :: unit_used
+
+do i = 10, 99
+   lun = i
+   inquire(unit=lun,opened=unit_used)
+   if (.not. unit_used) then
+      iostat = 0
+      return
+   endif
+enddo
+iostat = -1
+lun = -1
+end subroutine get_unit
+
+!----------------------------------------------------------
+subroutine add_eol(xf)
+type(xmlf_t), intent(inout)   :: xf
+
+integer :: indent_level
+character(len=100), parameter  ::  blanks =  ""
+
+indent_level = len(xf%stack) - 1
+write(unit=xf%lun,fmt="(a)") char(xf%buffer)
+call reset_buffer(xf%buffer)
+
+if (xf%indenting_requested) &
+   call add_to_buffer(blanks(1:indent_level),xf%buffer)
+
+end subroutine add_eol
+!------------------------------------------------------------
+subroutine dump_buffer(xf,lf)
+type(xmlf_t), intent(inout)   :: xf
+logical, intent(in), optional :: lf
+
+if (present(lf)) then
+   if (lf) then
+      write(unit=xf%lun,fmt="(a)",advance="yes") char(xf%buffer)
+   else
+      write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+   endif
+else
+   write(unit=xf%lun,fmt="(a)",advance="no") char(xf%buffer)
+endif
+call reset_buffer(xf%buffer)
+
+end subroutine dump_buffer
+
+!------------------------------------------------------------
+subroutine close_start_tag(xf,s)
+type(xmlf_t), intent(inout)   :: xf
+character(len=*), intent(in)  :: s
+
+if (.not. xf%start_tag_closed)  then
+   if (len(xf%dict) > 0)  call write_attributes(xf)
+   call add_to_buffer(s, xf%buffer)
+   xf%start_tag_closed = .true.
+endif
+
+end subroutine close_start_tag
+
+!-------------------------------------------------------------
+subroutine write_attributes(xf)
+type(xmlf_t), intent(inout)   :: xf
+
+integer  :: i, status, size
+character(len=100)  :: key, value
+
+do i = 1, len(xf%dict)
+   call get_key(xf%dict,i,key,status)
+   call get_value(xf%dict,key,value,status)
+   key = adjustl(key)
+   value = adjustl(value)
+   size = len_trim(key) + len_trim(value) + 4
+   if ((len(xf%buffer) + size) > COLUMNS) call add_eol(xf)
+   call add_to_buffer(" ", xf%buffer)
+   call add_to_buffer(trim(key), xf%buffer)
+   call add_to_buffer("=", xf%buffer)
+   call add_to_buffer("""",xf%buffer)
+   call add_to_buffer(trim(value), xf%buffer)
+   call add_to_buffer("""", xf%buffer)
+enddo
+
+end subroutine write_attributes
+
+!---------------------------------------------------------------
+    subroutine xml_AddArray_integer(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      integer, intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(6(i12))") a
+      endif
+    end subroutine xml_AddArray_integer
+
+!-------------------------------------------------------------------
+    subroutine xml_AddArray_real_dp(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      real(kind=dp), intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(4(es20.12))") a
+      endif
+    end subroutine xml_AddArray_real_dp
+
+!------------------------------------------------------------------
+    subroutine xml_AddArray_real_sp(xf,a,format)
+      type(xmlf_t), intent(inout)         :: xf
+      real(kind=sp), intent(in), dimension(:)   :: a
+      character(len=*), intent(in), optional  :: format
+
+      call close_start_tag(xf,">")
+      if (len(xf%buffer) > 0) call dump_buffer(xf,lf=.true.)
+      if (present(format)) then
+         write(xf%lun,format) a
+      else
+         write(xf%lun,"(4(es20.12))") a
+      endif
+    end subroutine xml_AddArray_real_sp
+
+end module m_wxml_core
+
Index: /OBSOLETE/XMLF90/src/wxml/m_wxml_dictionary.f90
===================================================================
--- /OBSOLETE/XMLF90/src/wxml/m_wxml_dictionary.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/wxml/m_wxml_dictionary.f90	(revision 2354)
@@ -0,0 +1,162 @@
+module m_wxml_dictionary
+
+private
+!
+! A very rough implementation for now
+! It uses fixed-length buffers for key/value pairs,
+! and the maximum number of dictionary items is hardwired.
+
+integer, parameter, private    :: MAX_ITEMS = 30
+type, public :: wxml_dictionary_t
+private
+      integer                               :: number_of_items ! = 0
+      character(len=100), dimension(MAX_ITEMS)  :: key
+      character(len=100), dimension(MAX_ITEMS)  :: value
+end type wxml_dictionary_t
+
+!
+! Building procedures
+!
+public  :: add_key_to_dict, add_value_to_dict, reset_dict
+
+!
+! Query and extraction procedures
+!
+public  :: len
+interface len
+   module procedure number_of_entries
+end interface
+public  :: number_of_entries
+public  :: get_key
+public  :: get_value
+public  :: has_key
+public  :: print_dict
+!
+interface get_value
+   module procedure wxml_get_value
+end interface
+
+CONTAINS
+
+!------------------------------------------------------
+function number_of_entries(dict) result(n)
+type(wxml_dictionary_t), intent(in)   :: dict
+integer                          :: n
+
+n = dict%number_of_items
+
+end function number_of_entries
+
+!------------------------------------------------------
+function has_key(dict,key) result(found)
+type(wxml_dictionary_t), intent(in)   :: dict
+character(len=*), intent(in)     :: key
+logical                          :: found
+
+integer  :: n, i
+found = .false.
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) == key) then
+         found = .true.
+         exit
+      endif
+enddo
+end function has_key
+
+!------------------------------------------------------
+subroutine wxml_get_value(dict,key,value,status)
+type(wxml_dictionary_t), intent(in)            :: dict
+character(len=*), intent(in)              :: key
+character(len=*), intent(out)             :: value
+integer, intent(out)                      :: status
+!
+integer  :: n, i
+
+status = -1
+n = dict%number_of_items
+do  i = 1, n
+      if (dict%key(i) == key) then
+         value = dict%value(i)
+         status = 0
+         RETURN
+      endif
+enddo
+
+end subroutine wxml_get_value
+
+!------------------------------------------------------
+subroutine get_key(dict,i,key,status)
+!
+! Get the i'th key
+!
+type(wxml_dictionary_t), intent(in)            :: dict
+integer, intent(in)                       :: i
+character(len=*), intent(out)             :: key
+integer, intent(out)                      :: status
+
+if (i <= dict%number_of_items) then
+      key = dict%key(i)
+      status = 0
+else
+      key = ""
+      status = -1
+endif
+
+end subroutine get_key
+
+!------------------------------------------------------
+subroutine add_key_to_dict(key,dict)
+character(len=*), intent(in)          :: key
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+if (n == MAX_ITEMS) then
+      write(unit=0,fmt=*) "Dictionary capacity exceeded !"
+      RETURN
+endif
+
+n = n + 1
+dict%key(n) = key
+dict%number_of_items = n
+
+end subroutine add_key_to_dict
+
+!------------------------------------------------------
+! Assumes we build the dictionary in an orderly fashion,
+! so one adds first the key and then immediately afterwards the value.
+!
+subroutine add_value_to_dict(value,dict)
+character(len=*), intent(in)          :: value
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+integer  :: n
+
+n = dict%number_of_items
+dict%value(n) = value
+
+end subroutine add_value_to_dict
+
+!------------------------------------------------------
+subroutine reset_dict(dict)
+type(wxml_dictionary_t), intent(inout)   :: dict
+
+dict%number_of_items = 0
+
+end subroutine reset_dict
+
+!------------------------------------------------------
+subroutine print_dict(dict)
+type(wxml_dictionary_t), intent(in)   :: dict
+
+integer  :: i
+
+do i = 1, dict%number_of_items
+      print *, trim(dict%key(i)), " = ", trim(dict%value(i))
+enddo
+
+end subroutine print_dict
+
+end module m_wxml_dictionary
Index: /OBSOLETE/XMLF90/src/wxml/m_wxml_elstack.f90
===================================================================
--- /OBSOLETE/XMLF90/src/wxml/m_wxml_elstack.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/wxml/m_wxml_elstack.f90	(revision 2354)
@@ -0,0 +1,143 @@
+module m_wxml_elstack
+
+private
+
+!
+! Simple stack to keep track of which elements have appeared so far
+!
+integer, parameter, private            :: STACK_SIZE = 20
+
+type, public :: elstack_t
+private
+      integer                                    :: n_items
+      character(len=100), dimension(STACK_SIZE)  :: data
+end type elstack_t
+
+public  :: push_elstack, pop_elstack, reset_elstack, print_elstack
+public  :: get_top_elstack, is_empty, get_elstack_signature
+public  :: len
+
+interface len
+   module procedure number_of_items
+end interface
+private :: number_of_items
+
+interface is_empty
+      module procedure is_empty_elstack
+end interface
+private :: is_empty_elstack
+
+CONTAINS
+
+!-----------------------------------------------------------------
+subroutine reset_elstack(elstack)
+type(elstack_t), intent(inout)  :: elstack
+
+elstack%n_items = 0
+
+end subroutine reset_elstack
+
+!-----------------------------------------------------------------
+function is_empty_elstack(elstack) result(answer)
+type(elstack_t), intent(in)  :: elstack
+logical                    :: answer
+
+answer = (elstack%n_items == 0)
+end function is_empty_elstack
+
+!-----------------------------------------------------------------
+function number_of_items(elstack) result(n)
+type(elstack_t), intent(in)  :: elstack
+integer                      :: n
+
+n = elstack%n_items
+end function number_of_items
+
+!-----------------------------------------------------------------
+subroutine push_elstack(item,elstack)
+character(len=*), intent(in)      :: item
+type(elstack_t), intent(inout)  :: elstack
+
+integer   :: n
+
+n = elstack%n_items
+if (n == STACK_SIZE) then
+      stop "*Element stack full"
+endif
+n = n + 1
+elstack%data(n) = item
+elstack%n_items = n
+
+end subroutine push_elstack
+
+!-----------------------------------------------------------------
+subroutine pop_elstack(elstack,item)
+type(elstack_t), intent(inout)     :: elstack
+character(len=*), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+elstack%n_items = n - 1
+
+end subroutine pop_elstack
+
+!-----------------------------------------------------------------
+subroutine get_top_elstack(elstack,item)
+!
+! Get the top element of the stack, *without popping it*.
+!
+type(elstack_t), intent(in)        :: elstack
+character(len=*), intent(out)        :: item
+
+!
+! We assume the elstack is not empty... (the user has called is_empty first)
+!
+integer   :: n
+
+n = elstack%n_items
+if (n == 0) then
+      stop "*********Element stack empty"
+endif
+item = elstack%data(n)
+
+end subroutine get_top_elstack
+
+!-----------------------------------------------------------------
+subroutine print_elstack(elstack,unit)
+type(elstack_t), intent(in)   :: elstack
+integer, intent(in)           :: unit
+integer   :: i
+
+do i = elstack%n_items, 1, -1
+      write(unit=unit,fmt=*) trim(elstack%data(i))
+enddo
+
+end subroutine print_elstack
+
+!-------------------------------------------------------------
+subroutine get_elstack_signature(elstack,string)
+type(elstack_t), intent(in)   :: elstack
+character(len=*), intent(out) :: string
+integer   :: i, length, j
+
+string = ""
+j = 0
+do i = 1, elstack%n_items
+   length = len_trim(elstack%data(i))
+   string(j+1:j+1) = "/"
+   j = j+1
+   string(j+1:j+length) = trim(elstack%data(i))
+   j = j + length
+enddo
+
+end subroutine get_elstack_signature
+
+end module m_wxml_elstack
Index: /OBSOLETE/XMLF90/src/wxml/m_wxml_text.f90
===================================================================
--- /OBSOLETE/XMLF90/src/wxml/m_wxml_text.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/wxml/m_wxml_text.f90	(revision 2354)
@@ -0,0 +1,73 @@
+module m_wxml_text
+!
+integer, private, parameter ::  sp = selected_real_kind(6,30)
+integer, private, parameter ::  dp = selected_real_kind(14,100)
+!
+! TODO : Add optional format parameter
+!
+private
+
+public :: str
+
+interface str
+   module procedure  str_integer,  str_real_dp, str_real_sp, &
+                     str_logical
+end interface
+private :: str_integer,  str_real_dp, str_real_sp, str_logical
+
+CONTAINS
+
+      function str_integer(int,format) result(s)
+      integer, intent(in)   :: int
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) int
+      else
+         write(s,"(i25)") int
+      endif
+      s = adjustl(s)
+      end function str_integer
+
+      function str_logical(log,format) result(s)
+      logical, intent(in)   :: log
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) log
+      else
+         write(s,"(l1)") log
+      endif
+      s = adjustl(s)
+      end function str_logical
+
+      function str_real_dp(x,format) result(s)
+      real(kind=dp), intent(in)   :: x
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) x
+      else
+         write(s,"(g22.12)") x
+      endif
+      s = adjustl(s)
+      end function str_real_dp
+
+      function str_real_sp(x,format) result(s)
+      real(kind=sp), intent(in)   :: x
+      character(len=*), intent(in), optional  :: format
+      character(len=100)    :: s
+
+      if (present(format)) then
+         write(s,format) x
+      else
+         write(s,"(g22.12)") x
+      endif
+      s = adjustl(s)
+      end function str_real_sp
+
+
+end module m_wxml_text
Index: /OBSOLETE/XMLF90/src/xpath/Ba.xml
===================================================================
--- /OBSOLETE/XMLF90/src/xpath/Ba.xml	(revision 2354)
+++ /OBSOLETE/XMLF90/src/xpath/Ba.xml	(revision 2354)
@@ -0,0 +1,34 @@
+<?xml version="1.0"?>
+<atom version="0.1">
+
+  <job type="pseudopotential-generation">
+
+  <!-- Note that this configuration is ionic (+2) -->
+  <title>pg Ba with 5s as semicore, 5p in valence -- soft Vf </title>
+  <symbol>Ba</symbol>
+  <pseudo flavor="tm2" core-corrections="no" />
+  <calculation relativistic="yes" spin-polarized="no" xc="ca" />
+  <configuration ncore="9" nvalence="4" >
+     <shell n="5" l="0" occupation="2.00" rc="1.75" />
+     <shell n="5" l="1" occupation="6.00" rc="2.00" />
+     <shell n="5" l="2" occupation="0.00" rc="2.50" />
+     <shell n="4" l="3" occupation="0.00" rc="2.50" />
+  </configuration>
+  <analysis logder="3.0" />
+
+  </job>
+  <job type="pseudopotential-test">
+
+  <!-- Note that this configuration is ionic (+2) -->
+  <title>test Ba </title>
+  <symbol>Ba</symbol>
+  <calculation relativistic="yes" spin-polarized="no" xc="ca" />
+  <configuration ncore="9" nvalence="4" >
+     <shell n="5" l="0" occupation="2.00"  />
+     <shell n="5" l="1" occupation="5.00"  />
+     <shell n="5" l="2" occupation="1.00"  />
+     <shell n="4" l="3" occupation="0.00"  />
+  </configuration>
+
+  </job>
+</atom>
Index: /OBSOLETE/XMLF90/src/xpath/Developer.Guide
===================================================================
--- /OBSOLETE/XMLF90/src/xpath/Developer.Guide	(revision 2354)
+++ /OBSOLETE/XMLF90/src/xpath/Developer.Guide	(revision 2354)
@@ -0,0 +1,63 @@
+Developer Notes for the XPATH-lite API
+
+This API is built on top of the more fundamental SAX one. The basic
+idea is to have a set of programable handlers that communicate among
+themselves and with the parser via module variables.
+
+A new pseudo-handler, "signal_handler", has been added to the optional
+argument list of xml_parse(). In the current implementation it just
+checks whether a stop signal has been raised by the user side of the
+program (for example, after a "begin tag" event, or after going out
+of the scope of a parent element).
+
+Since the SAX parser is stream-oriented, and XPATH searches can be
+done in any order, there are new routines to rewind the XML file and
+to synchronize the physical file reader with a previously saved point
+in the XML tree. 
+
+These tools, and the rather sophisticated path-matching routine
+provided (which allows for wildcards and the "//" construction) would
+be enough for standard use, as implemented in the routine
+"get_node". However, there is also the possibility of performing
+searches constrained to a given ancestor element ("context" searches)
+so that blocks of logically related information can be processed
+together. A context is implicitly created by a call to
+"mark_node". Contexts can be saved and "synched" to, allowing for
+repeated constrained searches (calls with relative paths). Contexts
+can even be passed to subroutines to package the parsing of common
+elements once and for all. (See for example Examples/xpath/pseudo.f90).
+This feature is nevertheless in need of a more rigorous specification:
+
+* What should be the behavior if a "mark_node" is followed by a
+  call to "get_node" with an absolute path?
+* Should there always be an "automatic rewind" to the beginning of the
+  context before any successive calls to "get_node"?
+
+
+LIMITATIONS
+
+The pcdata buffer provided by the user as a character variable could
+overflow.  Note that the parser itself uses a string of length
+MAX_PCDATA_SIZE (currently 65536) as a buffer to hold PCDATA. A
+warning is issued if there is not enough space (in the user or in the
+system buffer) to hold the data.
+
+Support for converting PCDATA characters to numerical arrays "on the
+fly" is planned for a forthcoming version.
+
+
+The coding style is that of the F subset of Fortran90. I strongly
+believe that it makes for better coding and fewer errors.
+Go to http://www.fortran.com/imagine1/ and get a feel for it. You can
+download free implementations for Linux and Windows, or get an
+inexpensive CD+Book combination to help support the project. Of course,
+F *is* Fortran, so you can always compile it with a Fortran compiler.
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/xpath/flib_xpath.f90
===================================================================
--- /OBSOLETE/XMLF90/src/xpath/flib_xpath.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/xpath/flib_xpath.f90	(revision 2354)
@@ -0,0 +1,12 @@
+module flib_xpath
+
+!
+! Stub module to gather all the XML functionality needed by the user
+! 
+use flib_sax
+use m_path
+
+public
+
+end module flib_xpath
+
Index: /OBSOLETE/XMLF90/src/xpath/m_path.f90
===================================================================
--- /OBSOLETE/XMLF90/src/xpath/m_path.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/xpath/m_path.f90	(revision 2354)
@@ -0,0 +1,617 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia <wdpgaara@lg.ehu.es>, August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save :: global_status
+integer, public, parameter :: END_OF_FILE = -1
+integer, public, parameter :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter :: PCDATA_OVERFLOW = 7
+
+logical, private, save :: debug_xpath = .false.
+logical, private, save :: debug_sax = .false.
+character(len=500), private, save :: path_required
+character(len=100), private, save :: target_path ! *** Hard limit
+
+
+logical, private, save :: in_target_element = .false.
+logical, private, save :: in_pcdata_level = .false.
+
+logical, private, save :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save :: full_node = .true.
+
+logical, private, save :: relative_path = .false.
+logical, private, save :: looking_for_current_element
+
+logical, private, save :: attributes_requested
+type(dictionary_t), private, save, pointer :: attributes_recovered
+
+integer, parameter, private :: MAX_PCDATA_SIZE = 65536
+logical, private, save :: pcdata_requested
+character(len=MAX_PCDATA_SIZE), private, &
+                                save :: pcdata_recovered !*** Hard
+integer, private, save :: len_pcdata
+integer, private, save :: max_len_pcdata
+
+type(xml_t), pointer, save, private :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional :: sax
+  debug_xpath = .true.
+  debug_sax = .false.
+  if (present(sax)) then
+     debug_sax = sax
+  endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+  debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml'
+! ready to process the rest of the element's contents (child elements'
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+integer, intent(out), optional :: status
+
+
+character(len=200) :: ancestor_path ! local variable
+
+     full_node = .false.
+     call process_node(fxml, &
+                       path,att_name,att_value, &
+                       attributes, &
+                       status=status)
+     if (status == 0) then
+        call xml_mark_path(fxml,ancestor_path)
+        if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+     endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained'
+! in the element's scope (but not child elements). It leaves the file handle'
+! physically and logically positioned:
+!
+! after the end of the element's start tag if 'pcdata' is not present'
+! after the end of the element's end tag if 'pcdata' is present'
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value,
+! which will be:
+!
+! 0 on success,
+! negative in case of end-of-file or end-of-ancestor-element, or
+! positive in case of a malfunction (such as the overflow of the
+! user's pcdata buffer).'
+!
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+     full_node = present(pcdata)
+     call process_node(fxml, &
+                       path,att_name,att_value, &
+                       attributes,pcdata, &
+                       status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+                        attributes,pcdata,&
+                        status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in), optional :: path
+character(len=*), intent(in), optional :: att_name
+character(len=*), intent(in), optional :: att_value
+type(dictionary_t), intent(out), optional :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3) :: any_path = "//*"
+character(len=200) :: local_path, ancestor_path ! *** Hard limit
+character(len=500) :: value ! *** Hard limit
+integer :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0 ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+   if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+   if (path(1:1) /= "/") then
+      !
+      ! Relative path search
+      !
+      call xml_path(fxml,local_path)
+      call xml_get_path_mark(fxml,ancestor_path)
+      if (ancestor_path == "") then
+        if (debug_xpath) print *, "Relative search with null ancestor..."
+      endif
+      relative_path = .true.
+      if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+                             trim(ancestor_path)
+      !
+      ! Convert to absolute path
+      local_path = trim(local_path) // "/" // trim(path)
+      if (debug_xpath) print *, "Converting ", trim(path), &
+               " to absolute path: ", trim(local_path)
+   else
+      local_path = path
+   endif
+else
+   local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints
+
+   if (debug_xpath) print *, "--> Calling get_path ..."
+   call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+   if (debug_xpath) print *, "-->Status after get_path: ", local_status
+   if (local_status /= 0) EXIT
+
+   if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+   if (att_name_present) then
+      if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+                          number_of_entries(local_attributes), " entries:"
+      if (debug_xpath) call print_dict(local_attributes)
+
+      if (has_key(local_attributes,att_name)) then
+
+         if (att_value_present) then
+            call get_value(local_attributes,att_name,value,local_status)
+            if (local_status /= 0) then
+               if (debug_xpath) print *, "Failed to get value of att: ", &
+                                    trim(att_name)
+               EXIT
+            endif
+
+            if (att_value == value) then
+               local_status = 0
+               if (debug_xpath) print *, "Got correct att name and value "
+               EXIT
+            else
+               if (debug_xpath) print *, "att value: ", trim(value), &
+                                   " does not match"
+               cycle ! We keep searching
+            endif
+         else ! Found att_name, and no value required
+            local_status = 0
+            if (debug_xpath) print *, "Got correct att name"
+            EXIT
+         endif
+      else ! Did not find that attribute name
+         if (debug_xpath) print *, "Att name not present"
+         cycle ! keep searching
+      endif
+   else ! Found path, and no att info required
+      local_status = 0
+      if (debug_xpath) print *, "Found correct path. No other reqs."
+      EXIT
+   endif
+
+enddo
+
+if (present(status)) then
+   status = local_status
+   if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+   attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target :: fxml
+character(len=*), intent(in) :: path
+type(dictionary_t), intent(out), optional, target :: attributes
+character(len=*), intent(out), optional, target :: pcdata
+integer, intent(out), optional :: status
+
+logical :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+      call reset_dict(attributes)
+      attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+! Make sure we do not overstep the bounds of the supplied argument
+!
+   max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+   len_pcdata = 0
+   pcdata_recovered(1:max_len_pcdata) = ""
+   if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+   if (debug_xpath) print *, "Returning info about current element"
+
+   ! We are now in the desired element, and we have the name and
+   ! attribute list saved in xp.
+   !
+   if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+   !
+   if (pcdata_requested) then
+   !
+   ! Set things up so that we can get the pcdata
+   !
+      call xml_path(xp,target_path)
+      in_target_element = .true.
+      in_pcdata_level = .true.
+   else
+      if (status_present) status = 0
+      RETURN ! We are done
+   endif
+else
+   target_path = ""
+   in_target_element = .false.
+   in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml, &
+               begin_element_handler = begin_element , &
+               end_element_handler = end_element, &
+               pcdata_chunk_handler = pcdata_handler, &
+               verbose = debug_sax, signal_handler=pause_parsing, &
+               empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+   global_status = END_OF_FILE
+   if (debug_xpath) print *, "Found end of file"
+   if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+   if (debug_xpath) print *, "Found end of ancestor element"
+   if (pcdata_requested) pcdata = ""
+else
+   if (debug_xpath) print *, "Parser found candidate element"
+   if (pcdata_requested) then
+      pcdata = pcdata_recovered(1:len_pcdata)
+      if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+   endif
+endif
+if (global_status > 0) then
+   if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " , trim(path)
+      in_target_element = .true.
+      target_path = path
+      in_pcdata_level = .true.
+      if (debug_xpath) print *, "In element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (.not. full_node) then
+         if (debug_xpath) print *, "Stopping parsing after initial tag"
+         stop_parsing = .true.
+      endif
+else
+   !
+   ! If we are at the pcdata level and we enter another element,
+   ! we must not read pcdata
+   !
+   if (in_pcdata_level) in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in) :: name
+
+character(len=300) :: path ! *** Hard limit
+character(len=300) :: left_path ! *** Hard limit
+character(len=300) :: ancestor_path ! *** Hard limit
+!
+
+call xml_path(xp,path) ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+   if (path == target_path) then
+      !
+      ! We are back to pcdata level after visiting child elements
+      !
+      in_pcdata_level = .true.
+
+   else if (left_path == target_path) then
+
+      ! We stop the parsing at the end of the element
+      !
+      if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+      in_target_element = .false.
+      in_pcdata_level = .false.
+      if (debug_xpath) print *, "Stopping parsing after end of target element"
+      stop_parsing = .true.
+   endif
+
+else if (relative_path) then
+   !
+   ! Check in case we go out of ancestor element
+   !
+   call xml_get_path_mark(xp,ancestor_path)
+   if (match(left_path,ancestor_path)) then
+      !
+      ! We are leaving the ancestor element
+      !
+      if (debug_xpath) print *, "Relative search. End of element: ", name
+      if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+      if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+      if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+
+      stop_parsing = .true.
+      global_status = END_OF_ANCESTOR_ELEMENT
+   endif
+endif
+
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in) :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300) :: path ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " , trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " , trim(path)
+      if (debug_xpath) print *, "In (empty) element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      stop_parsing = .true.
+      if (debug_xpath) print *, "Stopping parsing after empty tag"
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (full_node) then
+         if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+      endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in) :: chunk
+
+integer :: len_chunk
+
+if (in_pcdata_level) then
+   !
+   ! Build pcdata_recovered chunk by chunk, until it overflows
+   !
+   if (pcdata_requested) then
+      if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+      len_chunk = len(chunk)
+      if ((len_pcdata + len_chunk) > max_len_pcdata) then
+         !
+         if (debug_xpath) print *, "***Pcdata Overflow "
+         global_status = PCDATA_OVERFLOW
+         stop_parsing = .true.
+         return
+      endif
+      pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+      len_pcdata = len_pcdata + len_chunk
+   endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out) :: res
+
+res = stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in) :: p
+character(len=*), intent(in) :: ptarget
+logical :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+! /pseudo/vps/radfunc [1]
+! //radfunc/data
+! //data
+! //*/vps/data
+! //job//data      
+! //*
+!
+integer :: len_target, len_path, pos_target, pos_path
+character(len=100) :: anchor_leaf ! *** Hard limit
+
+res_match = .false.
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   return
+
+else if (ptarget == "/") then
+   ! We process // in the middle below
+
+   res_match = .true.
+   return
+
+else ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   if (pos_target == len_target) then ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         if (pos_target == 1) then ! Target begins by /.// 
+            res_match = .true.
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         if (anchor_leaf == "/.") then ! keep searching
+            len_target = pos_target
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up in target path.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         RETURN ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else if (p(pos_path+1:len_path) == &
+             ptarget(pos_target+1:len_target)) then
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end module m_path
Index: /OBSOLETE/XMLF90/src/xpath/m_path_orig.f90
===================================================================
--- /OBSOLETE/XMLF90/src/xpath/m_path_orig.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/xpath/m_path_orig.f90	(revision 2354)
@@ -0,0 +1,629 @@
+module m_path
+!
+! XPATH-like API for XML Parsing
+! Copyright Alberto Garcia <wdpgaara@lg.ehu.es>, August 2003
+!
+use flib_sax
+
+private
+!
+public :: get_node, mark_node, enable_debug, disable_debug
+
+private :: match, process_node, get_path
+private :: begin_element, end_element, pcdata_handler, empty_element
+private :: pause_parsing
+
+!
+integer, private, save                   :: global_status
+integer, public, parameter               :: END_OF_FILE  = -1
+integer, public, parameter               :: END_OF_ANCESTOR_ELEMENT = -2
+integer, public, parameter               :: PCDATA_OVERFLOW = 7
+
+logical, private, save                   :: debug_xpath = .false.
+logical, private, save                   :: debug_sax = .false.
+character(len=500), private, save        :: path_required
+character(len=100), private, save        :: target_path      ! *** Hard limit
+
+
+logical, private, save                   :: in_target_element = .false.
+logical, private, save                   :: in_pcdata_level = .false.
+
+logical, private, save                   :: stop_parsing = .false.
+!
+! This global variable determines whether we stop after
+! getting the initial element tag, or after digesting the full node.
+!
+logical, private, save                   :: full_node = .true.
+
+logical, private, save                   :: relative_path = .false.
+logical, private, save                   :: looking_for_current_element
+                             
+logical, private, save                        :: attributes_requested
+type(dictionary_t), private, save, pointer    :: attributes_recovered
+
+integer, parameter, private                   :: MAX_PCDATA_SIZE = 65536
+logical, private, save                        :: pcdata_requested 
+character(len=MAX_PCDATA_SIZE), private, &
+                                save          :: pcdata_recovered !*** Hard 
+integer, private, save                        :: len_pcdata
+integer, private, save                        :: max_len_pcdata
+
+type(xml_t), pointer, save, private           :: xp
+
+CONTAINS !===========================================================
+
+!----------------------------------------------------
+! Debugging control
+!
+subroutine enable_debug(sax)
+logical, intent(in), optional  :: sax
+  debug_xpath = .true.
+  debug_sax = .false.
+  if (present(sax)) then
+     debug_sax = sax
+  endif
+end subroutine enable_debug
+
+subroutine disable_debug()
+  debug_xpath = .false.
+end subroutine disable_debug
+
+!----------------------------------------------------
+! Main routines
+!---------------------------------------------------------------------
+subroutine mark_node(fxml,path,att_name,att_value,attributes,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary, and leaving the file handle fxml
+! ready to process the rest of the element's contents (child elements
+! and/or pcdata).
+!
+! Side effects: it sets "ancestor_path" to the element's path
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value, 
+! which will be:
+!
+!   0 on success,
+!   negative in case of end-of-file or end-of-ancestor-element, or 
+!   positive in case of a malfunction 
+!
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+integer, intent(out), optional               :: status
+
+
+character(len=200)         :: ancestor_path           ! local variable
+
+     full_node = .false.
+     call process_node(fxml,                    &
+                       path,att_name,att_value, &
+                       attributes,              &
+                       status=status)
+     if (status == 0) then
+        call xml_mark_path(fxml,ancestor_path)
+        if (debug_xpath) print *, "Setting ancestor_path to: ", trim(ancestor_path)
+     endif
+
+end subroutine mark_node
+
+!--------------------------------------------------------------------
+subroutine get_node(fxml,path,att_name,att_value,attributes,pcdata,status)
+!
+! Performs a search of a given element (by path, and/or presence of
+! a given attribute and/or value of that attribute), returning optionally
+! the element's attribute dictionary and any PCDATA characters contained
+! in the element's scope (but not child elements). It leaves the file handle
+! physically and logically positioned:
+!
+!     after the end of the element's start tag if 'pcdata' is not present
+!     after the end of the element's end tag if 'pcdata' is present
+!
+! If the argument "path" is present and evaluates to a relative path (a
+! string not beginning with "/"), the search is interrupted after the end
+! of the "ancestor_element" set by a previous call to "mark_node".
+! If not earlier, the search ends at the end of the file.
+!
+! The status argument, if present, will hold a return value, 
+! which will be:
+!
+!   0 on success,
+!   negative in case of end-of-file or end-of-ancestor-element, or 
+!   positive in case of a malfunction (such as the overflow of the 
+!   user's pcdata buffer).
+!
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional               :: status
+
+     full_node = present(pcdata)
+     call process_node(fxml,                    &
+                       path,att_name,att_value, &
+                       attributes,pcdata,       &
+                       status=status)
+
+end subroutine get_node
+!
+!--------------------------------------------------------------------
+! Workhorse routines follow
+!--------------------------------------------------------------------
+subroutine process_node(fxml,path,att_name,att_value, &
+                        attributes,pcdata,&
+                        status)
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in), optional       :: path
+character(len=*), intent(in), optional       :: att_name
+character(len=*), intent(in), optional       :: att_value
+type(dictionary_t), intent(out), optional    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional               :: status
+
+logical :: path_present, att_name_present, att_value_present
+logical :: attributes_present
+
+character(len=3)   :: any_path  = "//*"
+character(len=200) :: local_path, ancestor_path      ! *** Hard limit
+character(len=500) :: value                          ! *** Hard limit
+integer            :: local_status
+
+type(dictionary_t) :: local_attributes
+
+global_status = 0           ! reset
+
+path_present = present(path)
+attributes_present = present(attributes)
+att_name_present = present(att_name)
+att_value_present = present(att_value)
+
+relative_path = .false.
+
+if (path_present) then
+   if (debug_xpath) print *, "SEARCHING for: ", trim(path)
+   if (path(1:1) /= "/") then
+      !
+      ! Relative path search
+      !
+      call xml_path(fxml,local_path)
+      call xml_get_path_mark(fxml,ancestor_path)
+      if (ancestor_path == "") then
+        if (debug_xpath) print *, "Relative search with null ancestor..."
+      endif
+      relative_path = .true.    
+      if (debug_xpath) print *, "Relative search. ANCESTOR ELEMENT: ", &
+                             trim(ancestor_path)
+      !
+      ! Convert to absolute path
+      local_path = trim(local_path) // "/" // trim(path)
+      if (debug_xpath) print *, "Converting ", trim(path), &
+               " to absolute path: ", trim(local_path)
+   else
+      local_path = path
+   endif
+else
+   local_path = any_path
+endif
+
+looking_for_current_element = (path == ".")
+!
+! Use local_attributes, since it is in principle possible that
+! the user does not need to get back the attribute list.
+!
+do ! Loop until we satisfy the constraints 
+   
+   if (debug_xpath) print *, "--> Calling get_path ..."
+   call get_path(fxml,local_path,local_attributes,pcdata,local_status)
+   if (debug_xpath) print *, "-->Status after get_path: ", local_status
+   if (local_status /= 0)  EXIT
+
+   if (debug_xpath) print *, "FOUND path matching: ", trim(local_path)
+
+   if (att_name_present) then
+      if (debug_xpath) print *, "Checking ", trim(att_name), " among ", &
+                          number_of_entries(local_attributes), " entries:"
+      if (debug_xpath) call print_dict(local_attributes)
+
+      if (has_key(local_attributes,att_name)) then
+
+         if (att_value_present) then
+            call get_value(local_attributes,att_name,value,local_status)
+            if (local_status /= 0) then
+               if (debug_xpath) print *, "Failed to get value of att: ", &
+                                    trim(att_name)
+               EXIT
+            endif
+
+            if (att_value == value)  then
+               local_status = 0
+               if (debug_xpath) print *, "Got correct att name and value "
+               EXIT
+            else
+               if (debug_xpath) print *, "att value: ", trim(value), &
+                                   " does not match"
+               cycle        ! We keep searching
+            endif
+         else           ! Found att_name, and no value required
+            local_status = 0
+            if (debug_xpath) print *, "Got correct att name"
+            EXIT
+         endif
+      else              ! Did not find that attribute name
+         if (debug_xpath) print *, "Att name not present"
+         cycle          ! keep searching
+      endif
+   else                 ! Found path, and no att info required
+      local_status = 0
+      if (debug_xpath) print *, "Found correct path. No other reqs."
+      EXIT
+   endif
+   
+enddo
+
+if (present(status)) then
+   status = local_status
+   if (debug_xpath) print *, "--Returning status: ", status
+endif
+
+if (attributes_present) then
+   attributes = local_attributes
+endif
+
+end subroutine process_node
+
+!--------------------------------------------------------------------
+subroutine get_path(fxml,path,attributes,pcdata,status)
+type(xml_t), intent(inout), target           :: fxml
+character(len=*), intent(in)                 :: path
+type(dictionary_t), intent(out), optional, target    :: attributes
+character(len=*), intent(out), optional, target      :: pcdata
+integer, intent(out), optional                       :: status  
+
+logical            :: status_present
+
+xp => fxml
+
+path_required = path
+status_present = present(status)
+pcdata_requested = (present(pcdata))
+
+attributes_requested = (present(attributes))
+if (attributes_requested) then
+      call reset_dict(attributes)
+      attributes_recovered => attributes
+endif
+
+if (pcdata_requested) then
+!
+!  Make sure we do not overstep the bounds of the supplied argument
+!
+   max_len_pcdata = min(len(pcdata),MAX_PCDATA_SIZE)
+   len_pcdata = 0
+   pcdata_recovered(1:max_len_pcdata) = ""
+   if (debug_xpath) print *, "Max length of pcdata store: ", max_len_pcdata
+endif
+
+if (looking_for_current_element) then
+   if (debug_xpath) print *, "Returning info about current element"
+
+   ! We are now in the desired element, and we have the name and
+   ! attribute list saved in xp.
+   !
+   if (attributes_requested) call xml_attributes(xp,attributes_recovered)
+   !
+   if (pcdata_requested) then
+   !
+   ! Set things up so that we can get the pcdata
+   !
+      call xml_path(xp,target_path)
+      in_target_element = .true.
+      in_pcdata_level = .true.
+   else
+      if (status_present) status = 0
+      RETURN              ! We are done
+   endif
+else
+   target_path = ""
+   in_target_element = .false.
+   in_pcdata_level = .false.
+endif
+
+stop_parsing = .false.
+
+call xml_parse(fxml,  &
+               begin_element_handler = begin_element , &
+               end_element_handler = end_element,  &
+               pcdata_chunk_handler = pcdata_handler, &
+               verbose = debug_sax, signal_handler=pause_parsing, &
+               empty_element_handler = empty_element)
+
+if (eof_xmlfile(fxml)) then
+   global_status = END_OF_FILE
+   if (debug_xpath) print *, "Found end of file"
+   if (pcdata_requested) pcdata = ""
+else if (global_status == END_OF_ANCESTOR_ELEMENT) then
+   if (debug_xpath) print *, "Found end of ancestor element"
+   if (pcdata_requested) pcdata = ""
+else
+   if (debug_xpath) print *, "Parser found candidate element"
+   if (pcdata_requested) then
+      pcdata = pcdata_recovered(1:len_pcdata)
+      if (debug_xpath) print *, "PCDATA recovered: ", pcdata_recovered(1:len_pcdata)
+   endif
+endif
+if (global_status > 0) then
+   if (debug_xpath) print *, "Something went slightly wrong. Status > 0"
+endif
+!
+if (present(status)) status = global_status  
+
+
+end subroutine get_path
+
+!==================================================================
+subroutine begin_element(name,attributes)
+character(len=*), intent(in)   :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=1000)   :: path              ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " begin_element ::: PATH: " ,  trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " ,  trim(path)
+      in_target_element = .true.
+      target_path = path
+      in_pcdata_level = .true.
+      if (debug_xpath) print *, "In element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (.not. full_node)  then
+         if (debug_xpath) print *, "Stopping parsing after initial tag"
+         stop_parsing = .true.
+      endif
+else 
+   !
+   ! If we are at the pcdata level and we enter another element, 
+   ! we must not read pcdata
+   !
+   if (in_pcdata_level)   in_pcdata_level = .false.
+endif
+
+end subroutine begin_element
+!------------------------------------------------------------
+subroutine end_element(name)
+character(len=*), intent(in)   :: name
+
+character(len=300)   :: path             ! *** Hard limit
+character(len=300)   :: left_path        ! *** Hard limit
+character(len=300)   :: ancestor_path    ! *** Hard limit
+!
+
+call xml_path(xp,path)   ! path *after* leaving element
+left_path = trim(path) // "/" // trim(name)
+
+if (in_target_element) then
+   if (path == target_path) then
+      ! 
+      ! We are back to pcdata level after visiting child elements
+      !
+      in_pcdata_level = .true.
+
+   else  if (left_path == target_path) then
+
+      ! We stop the parsing at the end of the element
+      !
+      if (debug_xpath) print *, "Exiting target element: ", trim(target_path)
+      in_target_element = .false.
+      in_pcdata_level = .false.
+      if (debug_xpath) print *, "Stopping parsing after end of target element"
+      stop_parsing = .true.
+   endif
+   
+else if (relative_path) then
+   !
+   ! Check in case we go out of ancestor element
+   !
+   call xml_get_path_mark(xp,ancestor_path)
+   if (match(left_path,ancestor_path)) then
+      !
+      ! We are leaving the ancestor element
+      !
+      if (debug_xpath) print *, "Relative search. End of element: ", name
+      if (debug_xpath) print *, "Leaving Path: ", trim(left_path)
+      if (debug_xpath) print *, "Ancestor Path: ", trim(ancestor_path)
+      if (debug_xpath) print *, "Stopping parsing after end of ancestor element"
+    
+      stop_parsing = .true.
+      global_status = END_OF_ANCESTOR_ELEMENT
+   endif
+endif
+  
+end subroutine end_element
+
+!------------------------------------------------------------
+subroutine empty_element(name,attributes)
+character(len=*), intent(in)   :: name
+type(dictionary_t), intent(in) :: attributes
+
+character(len=300)   :: path              ! *** Hard limit
+
+call xml_path(xp,path)
+if (debug_xpath) print *, " empty_element ::: PATH: " ,  trim(path)
+if (debug_xpath) print *, "path: ", trim(path), " req: ", trim(path_required)
+if (match(path,path_required)) then
+      if (debug_xpath) print *, " Match path: " ,  trim(path)
+      if (debug_xpath) print *, "In (empty) element name: " , name
+      if (attributes_requested) attributes_recovered = attributes
+      ! stop parsing
+      stop_parsing = .true.
+      if (debug_xpath) print *, "Stopping parsing after empty tag"
+      if (debug_xpath) print *, "full_node: ", full_node
+      if (full_node)  then
+         if (debug_xpath) print *, "*Warning: full_node requested, empty tag found"
+      endif
+endif
+!
+! There is no logic for ancestor element handling, as by definition
+! an emtpy element cannot have children.
+!
+end subroutine empty_element
+
+!-----------------------------------------------------------
+subroutine pcdata_handler(chunk)
+character(len=*), intent(in)   :: chunk
+
+integer  :: len_chunk
+
+if (in_pcdata_level) then
+   ! 
+   ! Build pcdata_recovered chunk by chunk, until it overflows
+   !
+   if (pcdata_requested) then
+      if (debug_xpath) print *, "Found chunk of pcdata: ", chunk
+      len_chunk = len(chunk)
+      if ((len_pcdata + len_chunk) > max_len_pcdata) then
+         !
+         if (debug_xpath) print *, "***Pcdata Overflow "
+         global_status = PCDATA_OVERFLOW
+         stop_parsing = .true.
+         return
+      endif
+      pcdata_recovered(len_pcdata+1:len_pcdata+len_chunk) = chunk
+      len_pcdata = len_pcdata + len_chunk
+   endif
+endif
+
+end subroutine pcdata_handler
+!--------------------------------------------------------------------
+
+subroutine pause_parsing(res)
+logical, intent(out)  :: res
+
+res =  stop_parsing
+
+end subroutine pause_parsing
+!--------------------------------------------------------------------
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in)  :: p
+character(len=*), intent(in)  :: ptarget
+logical                       :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+!           /pseudo/vps/radfunc      [1]
+!           //radfunc/data
+!           //data
+!           //*/vps/data
+!           //job//data      
+!           //*
+!
+integer  :: len_target, len_path, pos_target, pos_path
+character(len=100)   :: anchor_leaf                     ! *** Hard limit
+
+res_match = .false.       
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   return
+
+else if (ptarget == "/") then
+   ! We  process // in the middle below
+
+   res_match = .true.
+   return
+
+else              ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   if (pos_target == len_target) then   ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do 
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         if (pos_target == 1) then  ! Target begins by /.// 
+            res_match = .true.
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         if (anchor_leaf == "/.") then  ! keep searching
+            len_target = pos_target 
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if  (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up in target path.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if  (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         RETURN   ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else  if (p(pos_path+1:len_path) ==  &
+             ptarget(pos_target+1:len_target)) then 
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end module m_path
+
+
+
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLF90/src/xpath/match_tester.f90
===================================================================
--- /OBSOLETE/XMLF90/src/xpath/match_tester.f90	(revision 2354)
+++ /OBSOLETE/XMLF90/src/xpath/match_tester.f90	(revision 2354)
@@ -0,0 +1,148 @@
+program m
+
+character(len=100) :: p, t
+logical            :: result
+
+do
+   write(unit=*,fmt="(a)",advance="no")  "Target path: "
+   read(unit=*,fmt="(a)") t
+   write(unit=*,fmt="(a)",advance="no")  "Path: "
+   read(unit=*,fmt="(a)") p
+
+   result = match(p,t)
+   print *, "Result: ", result
+
+enddo
+
+
+CONTAINS
+
+recursive function match(p,ptarget) result(res_match)
+character(len=*), intent(in)  :: p
+character(len=*), intent(in)  :: ptarget
+logical                       :: res_match
+
+!
+! Checks whether a given XML path matches the target path ptarget
+! Only absolute paths are considered.
+!
+! Examples of target paths:
+!
+!           /pseudo/vps/radfunc      [1]
+!           //radfunc/data
+!           //data
+!           //*/vps/data
+!           //job//data      
+!           //*
+!
+integer  :: len_target, len_path, pos_target, pos_path
+character(len=100)   :: anchor_leaf
+
+res_match = .false.       
+
+ print *, ":testing: "
+ print *, "          ", trim(p)
+ print *, " against: ", trim(ptarget)
+ print *, "-----------------------------------------"
+
+if (trim(p) == trim(ptarget)) then
+   res_match = .true.
+   print *, "outright equality"
+   return
+
+else if (ptarget == "/") then
+   ! We  process // in the middle below
+
+   res_match = .true.
+   print *, "target begins by //"
+   return
+
+else              ! We get the extreme elements
+
+   len_target = len_trim(ptarget)
+   len_path = len_trim(p)
+   pos_target = index(ptarget,"/",back=.true.)
+   pos_path = index(p,"/",back=.true.)
+
+   print *, " Path leaf: ", p(pos_path+1:len_path) 
+   print *, " Target leaf: ", ptarget(pos_target+1:len_target)
+
+   if (pos_target == len_target) then   ! // in the middle...
+      ! Get leaf further up
+      search_anchor : do 
+         print *, "looking for anchor in: ", ptarget(1:len_target-1)
+         print *, "press enter"
+         read *
+         pos_target = index(ptarget(1:len_target-1),"/",back=.true.)
+         print *, "pos_target in anchor search: ", pos_target
+         if (pos_target == 1) then  ! Target begins by /.// 
+            res_match = .true.
+            print *, "reached initial /.// in target"
+            return
+         endif
+         anchor_leaf = ptarget(pos_target:len_target-1)
+         print *, " Anchor leaf: ", trim(anchor_leaf)
+         if (anchor_leaf == "/.") then  ! keep searching
+            len_target = pos_target 
+            cycle search_anchor
+         else
+            exit search_anchor
+         endif
+      enddo search_anchor
+
+      ! Note that the anchor includes the leading /
+      ! Now we search for that anchor in the candidate path
+      !
+      print *, " Searching anchor in : ", trim(p(1:len_path))
+      pos_path = index(p(1:len_path),trim(anchor_leaf),back=.true.)
+      if (pos_path /= 0) then
+
+         ! Found anchor. Continue further up.
+         !
+         res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+      endif
+
+   else if  (ptarget(pos_target+1:len_target) == ".") then
+
+      ! A dot is a dummy. Continue further up.
+      !
+      res_match = match(p(1:len_path),ptarget(1:pos_target-1))
+
+   else if  (ptarget(pos_target+1:len_target) == "*") then
+
+      if (len_path == pos_path) then
+         print *, "empty element. len_path, pos_path: ", len_path, pos_path
+         RETURN   ! empty path element
+      endif
+
+      ! A star matches any non-empty leaf. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   else  if (p(pos_path+1:len_path) ==  &
+             ptarget(pos_target+1:len_target)) then 
+
+      ! Leafs are equal. Continue further up.
+      !
+      res_match = match(p(1:pos_path-1),ptarget(1:pos_target-1))
+
+   endif
+
+endif
+
+end function match
+
+end program m
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINKER              mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -i4 -r8 -automatic -align all -I/opt/mpi/current/include
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD              -r8 -automatic
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-IA64_PLATINE.path	(revision 2354)
@@ -0,0 +1,20 @@
+set NETCDF_INCDIR="-I/usr/include"
+set NETCDF_LIBDIR="-L/usr/lib"
+set NETCDF_LIB="-lnetcdff -lnetcdf"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+
+set OASIS_INCDIR="-I$PWD/../../prism/IA64/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/IA64/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
+
+set VAMPIR_INCDIR="-I/applications/intel/ict/3.0/itac/7.0/include"
+set VAMPIR_LIBDIR="-L/applications/intel/ict/3.0/itac/7.0/lib" 
+set VAMPIR_LIB="-lVT -lvtunwind -ldwarf -lelf -lpthread"
+
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-PW6_VARGAS.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-PW6_VARGAS.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-PW6_VARGAS.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            xlf_r
+%LINKER              mpxlf_r
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -qautodbl=dbl4
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O2 -qfullpath -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap
+%DEBUG_FFLAGS        -g -qfullpath -qnooptimize -qinitauto=7FBFFFFF  -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap
+%MPI_FFLAGS          -I/usr/lpp/ppe.poe/include/thread64
+%OMP_FFLAGS          
+%BASE_LD              
+%MPI_LD
+%OMP_LD              
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-PW6_VARGAS.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-PW6_VARGAS.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-PW6_VARGAS.path	(revision 2354)
@@ -0,0 +1,21 @@
+set NETCDF_LIBDIR=" "
+set NETCDF_INCDIR=" "
+set NETCDF_LIB=" "
+
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+
+set OASIS_INCDIR="-I$PWD/../../prism/AIX6/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/AIX6/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
+
+set VAMPIR_INCDIR=
+set VAMPIR_LIBDIR=
+set VAMPIR_LIB=
+
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            sxmpif90
+%LINKER              sxmpif90
+%AR                  sxar
+%MAKE                make
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole,-A idbl4,-ptr byte -EP -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
+%MPI_FFLAGS
+%OMP_FFLAGS          -P openmp 
+%BASE_LD             
+%MPI_LD
+%OMP_LD              -P openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_BRODIE.path	(revision 2354)
@@ -0,0 +1,12 @@
+set NETCDF_LIBDIR="-L/SXlocal/pub/netCDF/netCDF-3.6.1/lib"
+set NETCDF_INCDIR="-I/SXlocal/pub/netCDF/netCDF-3.6.1/include"
+set NETCDF_LIB="-lnetcdf"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+set OASIS_INCDIR="-I$PWD/../../prism/SX/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/SX/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_MERCURE.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_MERCURE.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_MERCURE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            sxmpif90
+%LINKER              sxmpif90
+%AR                  sxar
+%MAKE                make
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole,-A idbl4,-ptr byte -EP -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
+%MPI_FFLAGS
+%OMP_FFLAGS          -P openmp 
+%BASE_LD             -size_t64
+%MPI_LD
+%OMP_LD              -P openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_MERCURE.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_MERCURE.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX8_MERCURE.path	(revision 2354)
@@ -0,0 +1,12 @@
+set NETCDF_LIBDIR="-L/usr/local/SX8/soft/netcdf/lib"
+set NETCDF_INCDIR="-I/usr/local/SX8/soft/netcdf/include"
+set NETCDF_LIB="-lnetcdf"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+set OASIS_INCDIR="-I$PWD/../../prism/SX/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/SX/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX9_MERCURE.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX9_MERCURE.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX9_MERCURE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            sxmpif90
+%LINKER              sxmpif90
+%AR                  sxar
+%MAKE                make
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -P stack -Wf,-pvctl res=whole,-A idbl4,-ptr byte -EP -R5 -float0 -size_t64 -dw -Wf,"-pvctl loopcnt=999999 fullmsg noassume"
+%PROD_FFLAGS         -C vopt
+%DEV_FFLAGS          -C vsafe -gv -Wf,-init stack=nan,-init heap=nan
+%DEBUG_FFLAGS        -C debug -eC -Wf,-init stack=nan,-init heap=nan
+%MPI_FFLAGS
+%OMP_FFLAGS          -P openmp 
+%BASE_LD             -size_t64
+%MPI_LD
+%OMP_LD              -P openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX9_MERCURE.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX9_MERCURE.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-SX9_MERCURE.path	(revision 2354)
@@ -0,0 +1,12 @@
+set NETCDF_LIBDIR="-L/ccc/applications/sx9/netcdf-3.6.1/lib"
+set NETCDF_INCDIR="-I/ccc/applications/sx9/netcdf-3.6.1/include"
+set NETCDF_LIB="-lnetcdf"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+set OASIS_INCDIR="-I$PWD/../../prism/SX/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/SX/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_ADA.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_ADA.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_ADA.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpiifort
+%LINKER              mpiifort
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -shared-intel -mcmodel=large -integer-size 32 -real-size 64 -align all
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -shared-intel -mcmodel=large -integer-size 32 -real-size 64 -align all
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_ADA.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_ADA.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_ADA.path	(revision 2354)
@@ -0,0 +1,14 @@
+set NETCDF_INCDIR="-I/smplocal/pub/NetCDF/4.1.3/include"
+set NETCDF_LIBDIR="-L/smplocal/pub/NetCDF/4.1.3/lib -L/smplocal/pub/HDF5/1.8.9/seq/lib"
+set NETCDF_LIB="-lnetcdff -lnetcdf -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lz"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+
+set OASIS_INCDIR="-I$PWD/../../prism/X64/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/X64/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_CURIE.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_CURIE.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_CURIE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINKER              mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -xHost -i4 -r8 -automatic -align all
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD             -xHost -r8 -automatic
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_CURIE.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_CURIE.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_CURIE.path	(revision 2354)
@@ -0,0 +1,14 @@
+set NETCDF_INCDIR="-I$NETCDF_INC_DIR"
+set NETCDF_LIBDIR="-L$NETCDF_LIB_DIR"
+set NETCDF_LIB="-lnetcdff -lnetcdf"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+
+set OASIS_INCDIR="-I$PWD/../../prism/X64/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/X64/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_TITANE.fcm
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_TITANE.fcm	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_TITANE.fcm	(revision 2354)
@@ -0,0 +1,15 @@
+%COMPILER            mpif90
+%LINKER              mpif90
+%AR                  ar
+%MAKE                gmake
+%FPP_FLAGS           -P -traditional 
+%FPP_DEF             _NONE_
+%BASE_FFLAGS         -i4 -r8 -automatic -align all
+%PROD_FFLAGS         -O3
+%DEV_FFLAGS          -O3 -traceback
+%DEBUG_FFLAGS        -g -traceback
+%MPI_FFLAGS
+%OMP_FFLAGS          -openmp
+%BASE_LD              -r8 -automatic
+%MPI_LD
+%OMP_LD              -openmp
Index: /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_TITANE.path
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_TITANE.path	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/arch/arch-X64_TITANE.path	(revision 2354)
@@ -0,0 +1,14 @@
+set NETCDF_INCDIR="-I$NETCDF_INC_DIR"
+set NETCDF_LIBDIR="-L$NETCDF_LIB_DIR"
+set NETCDF_LIB="-lnetcdff -lnetcdf"
+set IOIPSL_INCDIR="-I$PWD/../../lib"
+set IOIPSL_LIBDIR="-L$PWD/../../lib"
+set IOIPSL_LIB="-lioipsl"
+
+set XMLF90_INCDIR="-I$PWD/../XMLF90/inc"
+set XMLF90_LIBDIR="-L$PWD/../XMLF90/lib"
+set XMLF90_LIB="-lxmlf90"
+
+set OASIS_INCDIR="-I$PWD/../../prism/X64/build/lib/psmile.MPI1"
+set OASIS_LIBDIR="-L$PWD/../../prism/X64/lib"
+set OASIS_LIB="-lpsmile.MPI1 -lmpp_io"
Index: /OBSOLETE/XMLIO_SERVER/trunk/bld.cfg
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/bld.cfg	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/bld.cfg	(revision 2354)
@@ -0,0 +1,50 @@
+# ----------------------- FCM extract configuration file -----------------------
+cfg::type                           bld
+cfg::version                        1.0
+
+
+# ------------------------------------------------------------------------------
+# Build information
+# ------------------------------------------------------------------------------
+
+inc arch.fcm
+inc config.fcm
+
+dir::root   $PWD
+
+search_src           0
+src::ioserver    src/IOSERVER
+src::xmlio       src/XMLIO
+bld::lib::ioserver         ioserver
+bld::lib::xmlio            xmlio
+bld::target libioserver.a libxmlio.a
+#bld::target main.exe client.exe server.exe
+bld::target server.exe
+
+bld::tool::fc        %COMPILER
+bld::tool::ld        %LINKER
+bld::tool::ar        %AR
+bld::tool::make      %MAKE
+bld::tool::fflags    %FFLAGS %INCDIR
+bld::tool::ldflags   %BASE_LD %LIB
+bld::tool::cppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppflags  %FPP_FLAGS %INCDIR
+bld::tool::fppkeys   %CPP_KEY
+# Pre-process code before analysing dependencies
+bld::pp              1
+
+
+# Ignore the following dependencies
+bld::excl_dep        inc::VT.inc
+bld::excl_dep        use::ioipsl
+bld::excl_dep        use::flib_dom
+bld::excl_dep        inc::mpif.h
+bld::excl_dep        use::mpi
+bld::excl_dep        use::mod_prism_get_comm
+bld::excl_dep        use::mod_prism_proto
+
+# Don't generate interface files
+bld::tool::geninterface none
+
+bld::outfile_ext::mod .mod
+bld::tool::SHELL   /bin/bash
Index: /OBSOLETE/XMLIO_SERVER/trunk/configure
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/configure	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/configure	(revision 2354)
@@ -0,0 +1,155 @@
+#!/bin/csh
+set verbose echo
+set has_arch_opt           = FALSE 
+set has_compile_opt        = FALSE
+set default_compile_flags  = "%PROD_FFLAGS"
+set has_use_vt             = FALSE
+set has_oasis              = FALSE
+set has_no_mpi             = FALSE
+
+top:
+if ($#argv > 0) then
+    switch ($1)
+
+    case -h
+
+########################################################################
+# Manuel en ligne
+########################################################################
+more <<eod
+
+
+configure_ioserver [Options] 
+
+bla, bla, bla
+eod
+exit
+
+########################################################################
+# Lecture des differentes options
+########################################################################
+                   
+    case -a
+    case -arch
+        set has_arch_opt = TRUE
+        set arch="$2" ; shift ; shift ; goto top
+
+    case -prod
+        set has_compile_opt = TRUE
+        set compile_flags="%PROD_FFLAGS"
+        shift ; goto top
+
+    case -dev
+        set has_compile_opt = TRUE
+        set compile_flags="%DEV_FFLAGS"
+        shift ; goto top
+
+    case -debug
+        set has_compile_opt = TRUE
+        set compile_flags="%DEBUG_FFLAGS"
+        shift ; goto top
+
+    case -use_vt
+        set has_use_vt = TRUE
+        shift ; goto top
+        
+    case -oasis
+        set has_oasis = TRUE
+        shift ; goto top
+
+    case -no_mpi
+        set has_no_mpi = TRUE
+        shift ; goto top
+   
+   default
+        echo "unknown option "$1" , exiting..."
+        exit 
+   endsw
+endif
+
+
+#define architecture files
+if ( $has_arch_opt == TRUE) then
+  if ( -e arch/arch-${arch}.fcm ) then
+    rm -f arch.fcm
+    ln -s arch/arch-${arch}.fcm arch.fcm
+  else
+    echo "architecture file : << arch/arch-${arch}.fcm >> is missing, exiting...."
+    exit
+  endif
+  
+  if ( -e arch/arch-${arch}.path ) then
+    rm -f arch.path
+    ln -s arch/arch-${arch}.path arch.path
+  else
+    echo "architecture file : << arch/arch-${arch}.path >> is missing, exiting...."
+    exit
+  endif
+else
+  echo "Warning : architecture not specified, taking default file <<arch.fcm>> and <<arch.path>>" 
+  if ( ! -e arch.fcm ) then
+    echo "architecture file : << arch.fcm >> is missing, exiting...."
+    exit
+  endif
+
+  if ( ! -e arch.fcm ) then
+    echo "architecture file : << arch.path >> is missing, exiting...."
+    exit
+  endif
+endif
+  
+# set compiler flags
+set FFLAGS="%BASE_FFLAGS"
+set LD_FFLAGS="%BASE_LD %MPI_LD"
+set CPP_KEY="%FPP_DEF"
+set INCDIR=""
+set LIB=""
+
+source ./arch.path
+
+# set compiler flags for optimisation
+if ( $has_compile_opt == FALSE ) then
+  set compile_flags=$default_compile_flags
+endif
+set FFLAGS=${FFLAGS}" %MPI_FFLAGS "$compile_flags
+
+
+# add path for xmlf90 library
+
+set INCDIR="$INCDIR $XMLF90_INCDIR"
+set LIB="$LIB $XMLF90_LIBDIR $XMLF90_LIB"
+
+# add path for ioipsl library
+set INCDIR="$INCDIR $IOIPSL_INCDIR"
+set LIB="$LIB $IOIPSL_LIBDIR $IOIPSL_LIB"
+
+if ( $has_oasis == TRUE ) then
+  set INCDIR="$INCDIR $OASIS_INCDIR"
+  set LIB="$LIB $OASIS_LIBDIR $OASIS_LIB"
+  set CPP_KEY="$CPP_KEY USE_OASIS"
+endif
+
+# add path for netcdf library
+set INCDIR="$INCDIR $NETCDF_INCDIR"
+set LIB="$LIB $NETCDF_LIBDIR $NETCDF_LIB"
+
+if ( $has_use_vt == TRUE ) then
+  set INCDIR="$INCDIR $VAMPIR_INCDIR"
+  set LIB="$LIB $VAMPIR_LIBDIR $VAMPIR_LIB"
+  set CPP_KEY="$CPP_KEY USE_VT"
+endif
+
+if ( $has_no_mpi == TRUE ) then
+  set CPP_KEY="NO_MPI $CPP_KEY"
+endif
+
+
+# build config file
+set config_fcm="config.fcm"
+rm -f $config_fcm
+
+echo "%FFLAGS        $FFLAGS"                           >  $config_fcm 
+echo "%CPP_KEY       $CPP_KEY"                          >> $config_fcm
+echo "%LD_FFLAGS     $LD_FFLAGS"                        >> $config_fcm
+echo "%INCDIR        $INCDIR"                           >> $config_fcm
+echo "%LIB           $LIB"                              >> $config_fcm
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/init_vampir.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/init_vampir.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/init_vampir.f90	(revision 2354)
@@ -0,0 +1,5 @@
+SUBROUTINE init_vampir
+USE mpitrace
+
+  CALL InitVampir
+END SUBROUTINE init_vampir
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/ios_mpif.h
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/ios_mpif.h	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/ios_mpif.h	(revision 2354)
@@ -0,0 +1,405 @@
+       INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
+       PARAMETER (MPI_SOURCE=3,MPI_TAG=4,MPI_ERROR=5)
+       INTEGER MPI_STATUS_SIZE
+       PARAMETER (MPI_STATUS_SIZE=5)
+       INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE)
+       INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1)
+       INTEGER MPI_ERRCODES_IGNORE(1)
+       CHARACTER*1 MPI_ARGVS_NULL(1,1)
+       CHARACTER*1 MPI_ARGV_NULL(1)
+       INTEGER MPI_SUCCESS
+       PARAMETER (MPI_SUCCESS=0)
+       INTEGER MPI_ERR_OTHER
+       PARAMETER (MPI_ERR_OTHER=15)
+       INTEGER MPI_ERR_WIN
+       PARAMETER (MPI_ERR_WIN=45)
+       INTEGER MPI_ERR_FILE
+       PARAMETER (MPI_ERR_FILE=27)
+       INTEGER MPI_ERR_COUNT
+       PARAMETER (MPI_ERR_COUNT=2)
+       INTEGER MPI_ERR_SPAWN
+       PARAMETER (MPI_ERR_SPAWN=42)
+       INTEGER MPI_ERR_BASE
+       PARAMETER (MPI_ERR_BASE=46)
+       INTEGER MPI_ERR_RMA_CONFLICT
+       PARAMETER (MPI_ERR_RMA_CONFLICT=49)
+       INTEGER MPI_ERR_IN_STATUS
+       PARAMETER (MPI_ERR_IN_STATUS=17)
+       INTEGER MPI_ERR_INFO_KEY
+       PARAMETER (MPI_ERR_INFO_KEY=29)
+       INTEGER MPI_ERR_LOCKTYPE
+       PARAMETER (MPI_ERR_LOCKTYPE=47)
+       INTEGER MPI_ERR_OP
+       PARAMETER (MPI_ERR_OP=9)
+       INTEGER MPI_ERR_ARG
+       PARAMETER (MPI_ERR_ARG=12)
+       INTEGER MPI_ERR_READ_ONLY
+       PARAMETER (MPI_ERR_READ_ONLY=40)
+       INTEGER MPI_ERR_SIZE
+       PARAMETER (MPI_ERR_SIZE=51)
+       INTEGER MPI_ERR_BUFFER
+       PARAMETER (MPI_ERR_BUFFER=1)
+       INTEGER MPI_ERR_DUP_DATAREP
+       PARAMETER (MPI_ERR_DUP_DATAREP=24)
+       INTEGER MPI_ERR_UNSUPPORTED_DATAREP
+       PARAMETER (MPI_ERR_UNSUPPORTED_DATAREP=43)
+       INTEGER MPI_ERR_LASTCODE
+       PARAMETER (MPI_ERR_LASTCODE=1073741823)
+       INTEGER MPI_ERR_TRUNCATE
+       PARAMETER (MPI_ERR_TRUNCATE=14)
+       INTEGER MPI_ERR_DISP
+       PARAMETER (MPI_ERR_DISP=52)
+       INTEGER MPI_ERR_PORT
+       PARAMETER (MPI_ERR_PORT=38)
+       INTEGER MPI_ERR_INFO_NOKEY
+       PARAMETER (MPI_ERR_INFO_NOKEY=31)
+       INTEGER MPI_ERR_ASSERT
+       PARAMETER (MPI_ERR_ASSERT=53)
+       INTEGER MPI_ERR_FILE_EXISTS
+       PARAMETER (MPI_ERR_FILE_EXISTS=25)
+       INTEGER MPI_ERR_PENDING
+       PARAMETER (MPI_ERR_PENDING=18)
+       INTEGER MPI_ERR_COMM
+       PARAMETER (MPI_ERR_COMM=5)
+       INTEGER MPI_ERR_KEYVAL
+       PARAMETER (MPI_ERR_KEYVAL=48)
+       INTEGER MPI_ERR_NAME
+       PARAMETER (MPI_ERR_NAME=33)
+       INTEGER MPI_ERR_REQUEST
+       PARAMETER (MPI_ERR_REQUEST=19)
+       INTEGER MPI_ERR_GROUP
+       PARAMETER (MPI_ERR_GROUP=8)
+       INTEGER MPI_ERR_TOPOLOGY
+       PARAMETER (MPI_ERR_TOPOLOGY=10)
+       INTEGER MPI_ERR_TYPE
+       PARAMETER (MPI_ERR_TYPE=3)
+       INTEGER MPI_ERR_TAG
+       PARAMETER (MPI_ERR_TAG=4)
+       INTEGER MPI_ERR_INFO_VALUE
+       PARAMETER (MPI_ERR_INFO_VALUE=30)
+       INTEGER MPI_ERR_NOT_SAME
+       PARAMETER (MPI_ERR_NOT_SAME=35)
+       INTEGER MPI_ERR_RMA_SYNC
+       PARAMETER (MPI_ERR_RMA_SYNC=50)
+       INTEGER MPI_ERR_INFO
+       PARAMETER (MPI_ERR_INFO=28)
+       INTEGER MPI_ERR_NO_MEM
+       PARAMETER (MPI_ERR_NO_MEM=34)
+       INTEGER MPI_ERR_BAD_FILE
+       PARAMETER (MPI_ERR_BAD_FILE=22)
+       INTEGER MPI_ERR_FILE_IN_USE
+       PARAMETER (MPI_ERR_FILE_IN_USE=26)
+       INTEGER MPI_ERR_UNKNOWN
+       PARAMETER (MPI_ERR_UNKNOWN=13)
+       INTEGER MPI_ERR_UNSUPPORTED_OPERATION
+       PARAMETER (MPI_ERR_UNSUPPORTED_OPERATION=44)
+       INTEGER MPI_ERR_QUOTA
+       PARAMETER (MPI_ERR_QUOTA=39)
+       INTEGER MPI_ERR_AMODE
+       PARAMETER (MPI_ERR_AMODE=21)
+       INTEGER MPI_ERR_ROOT
+       PARAMETER (MPI_ERR_ROOT=7)
+       INTEGER MPI_ERR_RANK
+       PARAMETER (MPI_ERR_RANK=6)
+       INTEGER MPI_ERR_DIMS
+       PARAMETER (MPI_ERR_DIMS=11)
+       INTEGER MPI_ERR_NO_SUCH_FILE
+       PARAMETER (MPI_ERR_NO_SUCH_FILE=37)
+       INTEGER MPI_ERR_SERVICE
+       PARAMETER (MPI_ERR_SERVICE=41)
+       INTEGER MPI_ERR_INTERN
+       PARAMETER (MPI_ERR_INTERN=16)
+       INTEGER MPI_ERR_IO
+       PARAMETER (MPI_ERR_IO=32)
+       INTEGER MPI_ERR_ACCESS
+       PARAMETER (MPI_ERR_ACCESS=20)
+       INTEGER MPI_ERR_NO_SPACE
+       PARAMETER (MPI_ERR_NO_SPACE=36)
+       INTEGER MPI_ERR_CONVERSION
+       PARAMETER (MPI_ERR_CONVERSION=23)
+       INTEGER MPI_ERRORS_ARE_FATAL
+       PARAMETER (MPI_ERRORS_ARE_FATAL=1409286144)
+       INTEGER MPI_ERRORS_RETURN
+       PARAMETER (MPI_ERRORS_RETURN=1409286145)
+       INTEGER MPI_IDENT
+       PARAMETER (MPI_IDENT=0)
+       INTEGER MPI_CONGRUENT
+       PARAMETER (MPI_CONGRUENT=1)
+       INTEGER MPI_SIMILAR
+       PARAMETER (MPI_SIMILAR=2)
+       INTEGER MPI_UNEQUAL
+       PARAMETER (MPI_UNEQUAL=3)
+       INTEGER MPI_MAX
+       PARAMETER (MPI_MAX=1476395009)
+       INTEGER MPI_MIN
+       PARAMETER (MPI_MIN=1476395010)
+       INTEGER MPI_SUM
+       PARAMETER (MPI_SUM=1476395011)
+       INTEGER MPI_PROD
+       PARAMETER (MPI_PROD=1476395012)
+       INTEGER MPI_LAND
+       PARAMETER (MPI_LAND=1476395013)
+       INTEGER MPI_BAND
+       PARAMETER (MPI_BAND=1476395014)
+       INTEGER MPI_LOR
+       PARAMETER (MPI_LOR=1476395015)
+       INTEGER MPI_BOR
+       PARAMETER (MPI_BOR=1476395016)
+       INTEGER MPI_LXOR
+       PARAMETER (MPI_LXOR=1476395017)
+       INTEGER MPI_BXOR
+       PARAMETER (MPI_BXOR=1476395018)
+       INTEGER MPI_MINLOC
+       PARAMETER (MPI_MINLOC=1476395019)
+       INTEGER MPI_MAXLOC
+       PARAMETER (MPI_MAXLOC=1476395020)
+       INTEGER MPI_REPLACE
+       PARAMETER (MPI_REPLACE=1476395021)
+       INTEGER MPI_COMM_WORLD
+       PARAMETER (MPI_COMM_WORLD=1140850688)
+       INTEGER MPI_COMM_SELF
+       PARAMETER (MPI_COMM_SELF=1140850689)
+       INTEGER MPI_GROUP_EMPTY
+       PARAMETER (MPI_GROUP_EMPTY=1207959552)
+       INTEGER MPI_COMM_NULL
+       PARAMETER (MPI_COMM_NULL=67108864)
+       INTEGER MPI_WIN_NULL
+       PARAMETER (MPI_WIN_NULL=536870912)
+       INTEGER MPI_FILE_NULL
+       PARAMETER (MPI_FILE_NULL=0)
+       INTEGER MPI_GROUP_NULL
+       PARAMETER (MPI_GROUP_NULL=134217728)
+       INTEGER MPI_OP_NULL
+       PARAMETER (MPI_OP_NULL=402653184)
+       INTEGER MPI_DATATYPE_NULL
+       PARAMETER (MPI_DATATYPE_NULL=201326592)
+       INTEGER MPI_REQUEST_NULL
+       PARAMETER (MPI_REQUEST_NULL=738197504)
+       INTEGER MPI_ERRHANDLER_NULL
+       PARAMETER (MPI_ERRHANDLER_NULL=335544320)
+       INTEGER MPI_INFO_NULL
+       PARAMETER (MPI_INFO_NULL=469762048)
+       INTEGER MPI_TAG_UB
+       PARAMETER (MPI_TAG_UB=1681915906)
+       INTEGER MPI_HOST
+       PARAMETER (MPI_HOST=1681915908)
+       INTEGER MPI_IO
+       PARAMETER (MPI_IO=1681915910)
+       INTEGER MPI_WTIME_IS_GLOBAL
+       PARAMETER (MPI_WTIME_IS_GLOBAL=1681915912)
+       INTEGER MPI_UNIVERSE_SIZE
+       PARAMETER (MPI_UNIVERSE_SIZE=1681915914)
+       INTEGER MPI_LASTUSEDCODE
+       PARAMETER (MPI_LASTUSEDCODE=1681915916)
+       INTEGER MPI_APPNUM
+       PARAMETER (MPI_APPNUM=1681915918)
+       INTEGER MPI_WIN_BASE
+       PARAMETER (MPI_WIN_BASE=1711276034)
+       INTEGER MPI_WIN_SIZE
+       PARAMETER (MPI_WIN_SIZE=1711276036)
+       INTEGER MPI_WIN_DISP_UNIT
+       PARAMETER (MPI_WIN_DISP_UNIT=1711276038)
+       INTEGER MPI_MAX_ERROR_STRING
+       PARAMETER (MPI_MAX_ERROR_STRING=512)
+       INTEGER MPI_MAX_NAME_STRING
+       PARAMETER (MPI_MAX_NAME_STRING=63)
+       INTEGER MPI_MAX_PORT_NAME
+       PARAMETER (MPI_MAX_PORT_NAME=256)
+       INTEGER MPI_MAX_OBJECT_NAME
+       PARAMETER (MPI_MAX_OBJECT_NAME=128)
+       INTEGER MPI_MAX_INFO_KEY
+       PARAMETER (MPI_MAX_INFO_KEY=255)
+       INTEGER MPI_MAX_INFO_VAL
+       PARAMETER (MPI_MAX_INFO_VAL=1024)
+       INTEGER MPI_MAX_PROCESSOR_NAME
+       PARAMETER (MPI_MAX_PROCESSOR_NAME=128)
+       INTEGER MPI_MAX_DATAREP_STRING
+       PARAMETER (MPI_MAX_DATAREP_STRING=128)
+       INTEGER MPI_UNDEFINED, MPI_UNDEFINED_RANK
+       PARAMETER (MPI_UNDEFINED=(-32766))
+       PARAMETER (MPI_UNDEFINED_RANK=(-32766))
+       INTEGER MPI_KEYVAL_INVALID
+       PARAMETER (MPI_KEYVAL_INVALID=603979776)
+       INTEGER MPI_BSEND_OVERHEAD
+       PARAMETER (MPI_BSEND_OVERHEAD=95)
+       INTEGER MPI_PROC_NULL
+       PARAMETER (MPI_PROC_NULL=-1)
+       INTEGER MPI_ANY_SOURCE
+       PARAMETER (MPI_ANY_SOURCE=-2)
+       INTEGER MPI_ANY_TAG
+       PARAMETER (MPI_ANY_TAG=-1)
+       INTEGER MPI_ROOT
+       PARAMETER (MPI_ROOT=-3)
+       INTEGER MPI_GRAPH
+       PARAMETER (MPI_GRAPH=1)
+       INTEGER MPI_CART
+       PARAMETER (MPI_CART=2)
+       INTEGER MPI_VERSION
+       PARAMETER (MPI_VERSION=2)
+       INTEGER MPI_SUBVERSION
+       PARAMETER (MPI_SUBVERSION=0)
+       INTEGER MPI_LOCK_EXCLUSIVE
+       PARAMETER (MPI_LOCK_EXCLUSIVE=234)
+       INTEGER MPI_LOCK_SHARED
+       PARAMETER (MPI_LOCK_SHARED=235)
+       INTEGER MPI_COMPLEX
+       PARAMETER (MPI_COMPLEX=1275072554)
+       INTEGER MPI_DOUBLE_COMPLEX
+       PARAMETER (MPI_DOUBLE_COMPLEX=1275072546)
+       INTEGER MPI_LOGICAL
+       PARAMETER (MPI_LOGICAL=1275069469)
+       INTEGER MPI_REAL
+       PARAMETER (MPI_REAL=1275070505)
+       INTEGER MPI_DOUBLE_PRECISION
+       PARAMETER (MPI_DOUBLE_PRECISION=1275070495)
+       INTEGER MPI_INTEGER
+       PARAMETER (MPI_INTEGER=1275069467)
+       INTEGER MPI_2INTEGER
+       PARAMETER (MPI_2INTEGER=1275070496)
+       INTEGER MPI_2COMPLEX
+       PARAMETER (MPI_2COMPLEX=1275072548)
+       INTEGER MPI_2DOUBLE_PRECISION
+       PARAMETER (MPI_2DOUBLE_PRECISION=1275072547)
+       INTEGER MPI_2REAL
+       PARAMETER (MPI_2REAL=1275070497)
+       INTEGER MPI_2DOUBLE_COMPLEX
+       PARAMETER (MPI_2DOUBLE_COMPLEX=1275076645)
+       INTEGER MPI_CHARACTER
+       PARAMETER (MPI_CHARACTER=1275068698)
+       INTEGER MPI_BYTE
+       PARAMETER (MPI_BYTE=1275068685)
+       INTEGER MPI_UB
+       PARAMETER (MPI_UB=(1275068433))
+       INTEGER MPI_LB
+       PARAMETER (MPI_LB=(1275068432))
+       INTEGER MPI_PACKED
+       PARAMETER (MPI_PACKED=(1275068687))
+       INTEGER MPI_INTEGER1
+       PARAMETER (MPI_INTEGER1=1275068717)
+       INTEGER MPI_INTEGER2
+       PARAMETER (MPI_INTEGER2=1275068975)
+       INTEGER MPI_INTEGER4
+       PARAMETER (MPI_INTEGER4=1275069488)
+       INTEGER MPI_INTEGER8
+       PARAMETER (MPI_INTEGER8=1275070513)
+       INTEGER MPI_INTEGER16
+       PARAMETER (MPI_INTEGER16=MPI_DATATYPE_NULL)
+       INTEGER MPI_REAL4
+       PARAMETER (MPI_REAL4=1275069479)
+       INTEGER MPI_REAL8
+       PARAMETER (MPI_REAL8=1275070505)
+       INTEGER MPI_REAL16
+       PARAMETER (MPI_REAL16=1275072555)
+       INTEGER MPI_COMPLEX8
+       PARAMETER (MPI_COMPLEX8=1275070504)
+       INTEGER MPI_COMPLEX16
+       PARAMETER (MPI_COMPLEX16=1275072554)
+       INTEGER MPI_COMPLEX32
+       PARAMETER (MPI_COMPLEX32=1275076652)
+       INTEGER MPI_ADDRESS_KIND, MPI_OFFSET_KIND
+       PARAMETER (MPI_ADDRESS_KIND=8)
+       PARAMETER (MPI_OFFSET_KIND=8)
+       INTEGER MPI_COMBINER_NAMED
+       PARAMETER (MPI_COMBINER_NAMED=1)
+       INTEGER MPI_COMBINER_DUP
+       PARAMETER (MPI_COMBINER_DUP=2)
+       INTEGER MPI_COMBINER_CONTIGUOUS
+       PARAMETER (MPI_COMBINER_CONTIGUOUS=3)
+       INTEGER MPI_COMBINER_VECTOR
+       PARAMETER (MPI_COMBINER_VECTOR=4)
+       INTEGER MPI_COMBINER_HVECTOR_INTEGER
+       PARAMETER (MPI_COMBINER_HVECTOR_INTEGER=5)
+       INTEGER MPI_COMBINER_HVECTOR
+       PARAMETER (MPI_COMBINER_HVECTOR=6)
+       INTEGER MPI_COMBINER_INDEXED
+       PARAMETER (MPI_COMBINER_INDEXED=7)
+       INTEGER MPI_COMBINER_HINDEXED_INTEGER
+       PARAMETER (MPI_COMBINER_HINDEXED_INTEGER=8)
+       INTEGER MPI_COMBINER_HINDEXED
+       PARAMETER (MPI_COMBINER_HINDEXED=9)
+       INTEGER MPI_COMBINER_INDEXED_BLOCK
+       PARAMETER (MPI_COMBINER_INDEXED_BLOCK=10)
+       INTEGER MPI_COMBINER_STRUCT_INTEGER
+       PARAMETER (MPI_COMBINER_STRUCT_INTEGER=11)
+       INTEGER MPI_COMBINER_STRUCT
+       PARAMETER (MPI_COMBINER_STRUCT=12)
+       INTEGER MPI_COMBINER_SUBARRAY
+       PARAMETER (MPI_COMBINER_SUBARRAY=13)
+       INTEGER MPI_COMBINER_DARRAY
+       PARAMETER (MPI_COMBINER_DARRAY=14)
+       INTEGER MPI_COMBINER_F90_REAL
+       PARAMETER (MPI_COMBINER_F90_REAL=15)
+       INTEGER MPI_COMBINER_F90_COMPLEX
+       PARAMETER (MPI_COMBINER_F90_COMPLEX=16)
+       INTEGER MPI_COMBINER_F90_INTEGER
+       PARAMETER (MPI_COMBINER_F90_INTEGER=17)
+       INTEGER MPI_COMBINER_RESIZED
+       PARAMETER (MPI_COMBINER_RESIZED=18)
+       INTEGER MPI_MODE_NOCHECK
+       PARAMETER (MPI_MODE_NOCHECK=1024)
+       INTEGER MPI_MODE_NOSTORE
+       PARAMETER (MPI_MODE_NOSTORE=2048)
+       INTEGER MPI_MODE_NOPUT
+       PARAMETER (MPI_MODE_NOPUT=4096)
+       INTEGER MPI_MODE_NOPRECEDE
+       PARAMETER (MPI_MODE_NOPRECEDE=8192)
+       INTEGER MPI_MODE_NOSUCCEED
+       PARAMETER (MPI_MODE_NOSUCCEED=16384)
+       INTEGER MPI_THREAD_SINGLE
+       PARAMETER (MPI_THREAD_SINGLE=0)
+       INTEGER MPI_THREAD_FUNNELED
+       PARAMETER (MPI_THREAD_FUNNELED=1)
+       INTEGER MPI_THREAD_SERIALIZED
+       PARAMETER (MPI_THREAD_SERIALIZED=2)
+       INTEGER MPI_THREAD_MULTIPLE
+       PARAMETER (MPI_THREAD_MULTIPLE=3)
+       INTEGER MPI_MODE_RDONLY
+       PARAMETER (MPI_MODE_RDONLY=2)
+       INTEGER MPI_MODE_RDWR
+       PARAMETER (MPI_MODE_RDWR=8)
+       INTEGER MPI_MODE_WRONLY
+       PARAMETER (MPI_MODE_WRONLY=4)
+       INTEGER MPI_MODE_DELETE_ON_CLOSE
+       PARAMETER (MPI_MODE_DELETE_ON_CLOSE=16)
+       INTEGER MPI_MODE_UNIQUE_OPEN
+       PARAMETER (MPI_MODE_UNIQUE_OPEN=32)
+       INTEGER MPI_MODE_CREATE
+       PARAMETER (MPI_MODE_CREATE=1)
+       INTEGER MPI_MODE_EXCL
+       PARAMETER (MPI_MODE_EXCL=64)
+       INTEGER MPI_MODE_APPEND
+       PARAMETER (MPI_MODE_APPEND=128)
+       INTEGER MPI_MODE_SEQUENTIAL
+       PARAMETER (MPI_MODE_SEQUENTIAL=256)
+       INTEGER MPI_SEEK_SET
+       PARAMETER (MPI_SEEK_SET=600)
+       INTEGER MPI_SEEK_CUR
+       PARAMETER (MPI_SEEK_CUR=602)
+       INTEGER MPI_SEEK_END
+       PARAMETER (MPI_SEEK_END=604)
+       INTEGER MPI_ORDER_C
+       PARAMETER (MPI_ORDER_C=56)
+       INTEGER MPI_ORDER_FORTRAN
+       PARAMETER (MPI_ORDER_FORTRAN=57)
+       INTEGER MPI_DISTRIBUTE_BLOCK
+       PARAMETER (MPI_DISTRIBUTE_BLOCK=121)
+       INTEGER MPI_DISTRIBUTE_CYCLIC
+       PARAMETER (MPI_DISTRIBUTE_CYCLIC=122)
+       INTEGER MPI_DISTRIBUTE_NONE
+       PARAMETER (MPI_DISTRIBUTE_NONE=123)
+       INTEGER MPI_DISTRIBUTE_DFLT_DARG
+       PARAMETER (MPI_DISTRIBUTE_DFLT_DARG=-49767)
+       INTEGER MPI_DISPLACEMENT_CURRENT
+       PARAMETER (MPI_DISPLACEMENT_CURRENT=-54278278)
+       INTEGER MPI_BOTTOM, MPI_IN_PLACE
+       EXTERNAL MPI_DUP_FN, MPI_NULL_DELETE_FN, MPI_NULL_COPY_FN
+       EXTERNAL MPI_WTIME, MPI_WTICK
+       EXTERNAL PMPI_WTIME, PMPI_WTICK
+       EXTERNAL MPI_COMM_DUP_FN, MPI_COMM_NULL_DELETE_FN
+       EXTERNAL MPI_COMM_NULL_COPY_FN
+       EXTERNAL MPI_WIN_DUP_FN, MPI_WIN_NULL_DELETE_FN
+       EXTERNAL MPI_WIN_NULL_COPY_FN
+       EXTERNAL MPI_TYPE_DUP_FN, MPI_TYPE_NULL_DELETE_FN
+       EXTERNAL MPI_TYPE_NULL_COPY_FN
+       DOUBLE PRECISION MPI_WTIME, MPI_WTICK
+       DOUBLE PRECISION PMPI_WTIME, PMPI_WTICK
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/main.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/main.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/main.f90	(revision 2354)
@@ -0,0 +1,70 @@
+PROGRAM ioslave
+USE mod_pack, ONLY : set_pack_buffer,pack_data,unpack_data
+USE mod_wait
+IMPLICIT NONE
+
+  INTEGER,DIMENSION(3) :: a=(/1,2,3/)
+  REAL                 :: b = 4.5
+  REAL                 :: c = 6.7
+  INTEGER,DIMENSION(3) :: aout
+  REAL                 :: bout,cout
+  LOGICAL,DIMENSION(5) :: d=(/.TRUE.,.FALSE.,.FALSE.,.TRUE.,.TRUE./)
+  LOGICAL,DIMENSION(5) :: dout
+  CHARACTER            :: e='C'
+  CHARACTER            :: eout
+  CHARACTER(len=11)    :: f(3)
+  CHARACTER(len=11)    :: fout(3)
+  INTEGER(kind=8),dimension(:),POINTER :: buffer
+  REAL,dimension(:),POINTER :: buffer_field
+  DOUBLE PRECISION :: t
+  
+  ALLOCATE(buffer(1024))
+  ALLOCATE(buffer_field(1024))
+  
+  CALL set_pack_buffer(buffer,1)
+  
+  f(1)="COUCOU1"
+  f(2)="COUCOU2"
+  f(3)="COUCOU3"
+  
+  CALL pack_data(b)
+  CALL pack_data(f)
+  CALL pack_data(a)
+  CALL pack_data(d)
+  CALL pack_data(e)
+  CALL pack_data(c)
+  
+  CALL set_pack_buffer(buffer,1)
+  CALL unpack_data(bout)
+  CALL unpack_data(fout)
+  CALL unpack_data(aout)
+  CALL unpack_data(dout)
+  CALL unpack_data(eout)
+  CALL unpack_data(cout)
+  
+  PRINT *,a,b,c,d,e,"  ",f
+  PRINT *,aout,bout,cout,dout,eout,"  ",fout
+
+  CALL Init_wait
+  
+  t=top()
+  CALL wait_us(10)
+  t=top()
+  
+  PRINT *,"ATTENTE 10 us",t
+
+  t=top()
+  CALL wait_us(250)
+  t=top()
+  
+  PRINT *,"ATTENTE 250 us",t
+
+  t=top()
+  CALL wait_us(1235)
+  t=top()
+  
+  PRINT *,"ATTENTE 1235 us",t
+
+
+END PROGRAM ioslave
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_box_grid.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_box_grid.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_box_grid.f90	(revision 2354)
@@ -0,0 +1,170 @@
+MODULE box_grid
+  
+  INTEGER, PARAMETER :: nb_grid_max=100
+  INTEGER            :: nb_grid=0
+
+  TYPE domain
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+  END TYPE domain
+  
+  TYPE grid
+    TYPE(domain)         :: local_domain
+    TYPE(domain),POINTER :: task_domain(:)
+    INTEGER                          :: ni
+    INTEGER                          :: nj
+    INTEGER                          :: nb_task
+  END TYPE grid
+  
+  TYPE(grid),SAVE,TARGET :: grids(nb_grid_max)
+  
+  INTEGER,SAVE :: max_ni
+  INTEGER,SAVE :: max_nj
+  INTEGER,SAVE :: max_vert_size = 100
+  REAL,SAVE,ALLOCATABLE :: Field_buffer(:,:,:) 
+  
+CONTAINS
+
+  SUBROUTINE create_new_grid(ni_glo,nj_glo,nb_task,id)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: ni_glo
+    INTEGER,INTENT(IN)  :: nj_glo
+    INTEGER,INTENT(IN)  :: nb_task
+    INTEGER,INTENT(OUT) :: id
+  
+    nb_grid=nb_grid+1
+    id=nb_grid
+    
+    grids(id)%ni=ni_glo
+    grids(id)%nj=nj_glo
+    grids(id)%nb_task=nb_task
+   
+    ALLOCATE(grids(id)%task_domain(nb_task))
+ 
+  END SUBROUTINE create_new_grid
+ 
+  SUBROUTINE Init_task_domain(id,task,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: id
+    INTEGER, INTENT(IN) :: task
+    INTEGER, INTENT(IN) :: ni
+    INTEGER, INTENT(IN) :: nj
+    INTEGER, INTENT(IN) :: ibegin
+    INTEGER, INTENT(IN) :: jbegin
+    REAL,    INTENT(IN) :: lon(ni,nj)
+    REAL,    INTENT(IN) :: lat(ni,nj)
+ 
+    TYPE(domain), POINTER :: Pt_dom
+    
+    Pt_dom=>grids(id)%task_domain(task)
+    
+    Pt_dom%ni=ni
+    Pt_dom%nj=nj
+    Pt_dom%ibegin=ibegin
+    Pt_dom%jbegin=jbegin   
+    Pt_dom%iend=ibegin+ni-1
+    Pt_dom%jend=jbegin+nj-1
+    ALLOCATE(Pt_dom%lon(ni,nj))
+    ALLOCATE(Pt_dom%lat(ni,nj))
+    Pt_dom%lon(:,:)=lon(:,:)
+    Pt_dom%lat(:,:)=lat(:,:)
+  
+  END SUBROUTINE Init_task_domain
+
+  
+  SUBROUTINE Init_grids
+  IMPLICIT NONE
+    INTEGER :: rank
+    INTEGER :: ib,ie,jb,je
+    TYPE(grid),POINTER :: Pt_grid
+    TYPE(domain),POINTER :: local_domain
+    TYPE(domain),POINTER :: task_domain(:)
+    INTEGER :: id
+    
+      max_ni=0
+      max_nj=0
+    
+      DO id=1,nb_grid
+        pt_grid=>grids(id)
+        local_domain=>pt_grid%local_domain
+        task_domain=>pt_grid%task_domain
+        
+        local_domain%ibegin=task_domain(1)%ibegin
+        local_domain%iend=task_domain(1)%iend
+        local_domain%jbegin=task_domain(1)%jbegin
+        local_domain%jend=task_domain(1)%jend
+      
+      DO rank=1,pt_grid%nb_task
+        IF (task_domain(rank)%ibegin < local_domain%ibegin)   local_domain%ibegin = task_domain(rank)%ibegin
+        IF (task_domain(rank)%iend   > local_domain%iend  )   local_domain%iend   = task_domain(rank)%iend
+        IF (task_domain(rank)%jbegin < local_domain%jbegin)   local_domain%jbegin = task_domain(rank)%jbegin
+        IF (task_domain(rank)%jend   > local_domain%jend  )   local_domain%jend   = task_domain(rank)%jend
+      ENDDO
+    
+      local_domain%ni = local_domain%iend-local_domain%ibegin+1
+      local_domain%nj = local_domain%jend-local_domain%jbegin+1
+      ALLOCATE(local_domain%lon(local_domain%ni,local_domain%nj))
+      ALLOCATE(local_domain%lat(local_domain%ni,local_domain%nj))
+      
+      DO rank=1,pt_grid%nb_task
+        ib=task_domain(rank)%ibegin-local_domain%ibegin+1
+        ie=task_domain(rank)%iend-local_domain%ibegin+1
+        jb=task_domain(rank)%jbegin-local_domain%jbegin+1
+        je=task_domain(rank)%jend-local_domain%jbegin+1
+
+        task_domain(rank)%ibegin=ib
+        task_domain(rank)%iend=ie
+        task_domain(rank)%jbegin=jb
+        task_domain(rank)%jend=je
+      
+        local_domain%lon(ib:ie,jb:je)=task_domain(rank)%lon(:,:)
+        local_domain%lat(ib:ie,jb:je)=task_domain(rank)%lat(:,:)
+      ENDDO
+  
+      IF (local_domain%ni > max_ni) max_ni=local_domain%ni
+      IF (local_domain%nj > max_nj) max_nj=local_domain%nj
+    ENDDO
+  
+    ALLOCATE(field_buffer(max_ni,max_nj,max_vert_size))
+    
+  END SUBROUTINE Init_grids
+  
+  SUBROUTINE bufferize_field2d(field,id,task)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:)
+    INTEGER,INTENT(IN) :: id
+    INTEGER,INTENT(IN) :: task
+    TYPE(domain), POINTER :: Pt
+
+    Pt=>grids(id)%task_domain(task)
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1)=field(:,:)
+      
+  END SUBROUTINE bufferize_field2d
+  
+  
+  SUBROUTINE bufferize_field3d(field,id,task)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:,:)
+    INTEGER,INTENT(IN) :: id
+    INTEGER,INTENT(IN) :: task
+    TYPE(domain), POINTER :: Pt
+   
+    Pt=>grids(id)%task_domain(task)
+
+    IF (size(field,3)>max_vert_size) THEN
+      DEALLOCATE(field_buffer)
+      max_vert_size=max_vert_size*2
+      ALLOCATE(field_buffer(max_ni,max_nj,max_vert_size))
+    ENDIF
+    
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1:size(field,3))=field(:,:,:)
+      
+  END SUBROUTINE bufferize_field3d
+    
+END MODULE box_grid
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_boxed_domain.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_boxed_domain.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_boxed_domain.f90	(revision 2354)
@@ -0,0 +1,145 @@
+MODULE boxed_domain
+
+  INTEGER,SAVE :: ni_glo
+  INTEGER,SAVE :: nj_glo
+  INTEGER,SAVE :: nb_proc
+  
+  TYPE local_domain
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+  END TYPE local_domain
+  
+  TYPE(local_domain),ALLOCATABLE,SAVE,TARGET :: domains(:)
+  
+  
+  INTEGER,SAVE :: ni
+  INTEGER,SAVE :: nj
+  INTEGER,SAVE :: ibegin
+  INTEGER,SAVE :: iend
+  INTEGER,SAVE :: jbegin
+  INTEGER,SAVE :: jend
+  
+  REAL,SAVE,ALLOCATABLE :: lon(:,:)
+  REAL,SAVE,ALLOCATABLE :: lat(:,:)
+  
+  INTEGER,SAVE :: max_vert_size = 100
+  REAL,SAVE,ALLOCATABLE :: Field_buffer(:,:,:)  
+  
+CONTAINS
+
+  SUBROUTINE Init_global_domain(ni_glo_,nj_glo_,nb_proc_)
+  IMPLICIT NONE
+  INTEGER, INTENT(IN) :: ni_glo_
+  INTEGER, INTENT(IN) :: nj_glo_
+  INTEGER, INTENT(IN) :: nb_proc_
+  
+    ni_glo=ni_glo_
+    nj_glo=nj_glo_
+    nb_proc=nb_proc_
+    
+    ALLOCATE(domains(nb_proc))
+ 
+  END SUBROUTINE Init_global_domain
+
+
+  SUBROUTINE Init_local_domain(rank,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: rank
+    INTEGER, INTENT(IN) :: ni
+    INTEGER, INTENT(IN) :: nj
+    INTEGER, INTENT(IN) :: ibegin    
+    INTEGER, INTENT(IN) :: jbegin
+    REAL, INTENT(IN)    :: lon(ni,nj)
+    REAL, INTENT(IN)    :: lat(ni,nj)
+    
+    domains(rank)%ni=ni
+    domains(rank)%nj=nj
+    domains(rank)%ibegin=ibegin
+    domains(rank)%jbegin=jbegin   
+    domains(rank)%iend=ibegin+ni-1
+    domains(rank)%jend=jbegin+nj-1
+    ALLOCATE(domains(rank)%lon(ni,nj))
+    ALLOCATE(domains(rank)%lat(ni,nj))
+    domains(rank)%lon(:,:)=lon(:,:)
+    domains(rank)%lat(:,:)=lat(:,:)
+  
+  END SUBROUTINE Init_local_domain
+  
+  
+  SUBROUTINE Init_domain
+  IMPLICIT NONE
+    INTEGER :: rank
+    INTEGER :: ib,ie,jb,je
+    ibegin=domains(1)%ibegin
+    iend=domains(1)%iend
+    jbegin=domains(1)%jbegin
+    jend=domains(1)%jend
+    
+    DO rank=1,nb_proc
+      IF (domains(rank)%ibegin<ibegin) ibegin=domains(rank)%ibegin
+      IF (domains(rank)%iend>iend) iend=domains(rank)%iend
+      IF (domains(rank)%jbegin<jbegin) jbegin=domains(rank)%jbegin
+      IF (domains(rank)%jend>jend) jend=domains(rank)%jend
+    ENDDO
+    
+    ni=iend-ibegin+1
+    nj=jend-jbegin+1
+    ALLOCATE(lon(ni,nj))
+    ALLOCATE(lat(ni,nj))
+    
+    DO rank=1,nb_proc
+      ib=domains(rank)%ibegin-ibegin+1
+      ie=domains(rank)%iend-ibegin+1
+      jb=domains(rank)%jbegin-jbegin+1
+      je=domains(rank)%jend-jbegin+1
+
+      domains(rank)%ibegin=ib
+      domains(rank)%iend=ie
+      domains(rank)%jbegin=jb
+      domains(rank)%jend=je
+      
+      lon(ib:ie,jb:je)=domains(rank)%lon(:,:)
+      lat(ib:ie,jb:je)=domains(rank)%lat(:,:)
+    ENDDO
+  
+    ALLOCATE(field_buffer(ni,nj,max_vert_size))
+    
+  END SUBROUTINE 
+  
+  SUBROUTINE bufferize_field2d(field,rank)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:)
+    INTEGER,INTENT(IN) :: rank
+    TYPE(local_domain), POINTER :: Pt
+
+    Pt=>domains(rank)
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1)=field(:,:)
+      
+  END SUBROUTINE bufferize_field2d
+  
+  
+  SUBROUTINE bufferize_field3d(field,rank)
+  IMPLICIT NONE
+    REAL,INTENT(IN) :: field(:,:,:)
+    INTEGER,INTENT(IN) :: rank
+    TYPE(local_domain), POINTER :: Pt
+   
+    Pt=>domains(rank)
+    IF (size(field,3)>max_vert_size) THEN
+      DEALLOCATE(field_buffer)
+      max_vert_size=max_vert_size*2
+      ALLOCATE(field_buffer(ni,nj,max_vert_size))
+    ENDIF
+    
+    field_buffer(Pt%ibegin:Pt%iend,Pt%jbegin:Pt%jend,1:size(field,3))=field(:,:,:)
+      
+  END SUBROUTINE bufferize_field3d
+
+    
+END MODULE boxed_domain
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_client.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_client.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_client.f90	(revision 2354)
@@ -0,0 +1,340 @@
+MODULE mod_event_client
+  USE mod_pack, ONLY : pack_data, pack_field
+  USE mod_mpi_buffer_client, ONLY : create_request, finalize_request,is_last_request
+  USE mod_event_parameters 
+  USE mod_ioserver_namelist
+      
+CONTAINS
+
+  SUBROUTINE event__swap_context(id)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_swap_context)
+      CALL pack_data(LEN(TRIM(id)))
+      CALL pack_data(TRIM(id))
+      CALL Finalize_request
+    ELSE
+      CALL iom__swap_context(TRIM(id))
+    ENDIF
+    
+  END SUBROUTINE  event__swap_context
+  
+  
+  SUBROUTINE event__parse_xml_file(filename)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: filename
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_parse_xml_file)
+      CALL pack_data(LEN(TRIM(filename)))
+      CALL pack_data(TRIM(filename))
+      CALL Finalize_request
+    ELSE
+      CALL iom__parse_xml_file(filename)
+    ENDIF
+    
+  END SUBROUTINE  event__parse_xml_file
+
+  SUBROUTINE event__set_vert_axis(vert_name,vert_value)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: vert_name
+    REAL,INTENT(IN)             :: vert_value(:)
+    
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_vert_axis)
+      CALL pack_data(LEN(TRIM(vert_name)))
+      CALL pack_data(TRIM(vert_name))
+      CALL pack_data(SIZE(vert_value))
+      CALL pack_data(vert_value)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_vert_axis(vert_name,vert_value)
+    ENDIF
+    
+  END SUBROUTINE  event__set_vert_axis
+
+  SUBROUTINE event__set_grid_dimension(name,ni_glo,nj_glo)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni_glo
+    INTEGER,INTENT(IN) :: nj_glo
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_dimension)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL pack_data(ni_glo)
+      CALL pack_data(nj_glo)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
+    ENDIF
+    
+  END SUBROUTINE event__set_grid_dimension
+
+  
+  SUBROUTINE event__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_domain)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL pack_data(ni)
+      CALL pack_data(nj)
+      CALL pack_data(ibegin)
+      CALL pack_data(jbegin)
+      CALL pack_data(lon)
+      CALL pack_data(lat)
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_domain
+
+  SUBROUTINE event__set_grid_type_nemo(name)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_type_nemo)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_type_nemo(name)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_type_nemo
+  
+  SUBROUTINE event__set_grid_type_lmdz(name,nbp,offset)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_grid_type_lmdz)
+      CALL pack_data(LEN(TRIM(name)))
+      CALL pack_data(TRIM(name))
+      CALL pack_data(nbp)
+      CALL pack_data(offset)
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_grid_type_lmdz(name,nbp,offset)
+    ENDIF
+      
+  END SUBROUTINE event__set_grid_type_lmdz
+  
+  SUBROUTINE event__set_time_parameters(itau0,zjulian,zdt)
+  USE iomanager
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: itau0
+    REAL,   INTENT(IN)  :: zjulian
+    REAL,   INTENT(IN)  :: zdt
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_time_parameters)
+      CALL pack_data(itau0)
+      CALL pack_data(zjulian)
+      CALL pack_data(zdt)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_time_parameters(itau0,zjulian,zdt)
+    ENDIF
+    
+  END SUBROUTINE event__set_time_parameters
+
+
+  SUBROUTINE event__set_calendar(str_calendar)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: str_calendar
+        
+    IF (using_server) THEN
+      CALL create_request(event_id_set_calendar)
+      CALL pack_data(LEN(TRIM(str_calendar)))
+      CALL pack_data(TRIM(str_calendar))
+      CALL Finalize_request
+    ELSE
+     CALL iom__set_calendar(str_calendar)
+    ENDIF
+      
+  END SUBROUTINE event__set_calendar
+  
+  
+  SUBROUTINE event__enable_field(varname)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+
+    IF (using_server) THEN
+      CALL create_request(event_id_enable_field)
+      CALL pack_data(len(varname))
+      CALL pack_data(varname)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__enable_field(varname)
+    ENDIF
+    
+  END SUBROUTINE event__enable_field
+
+  SUBROUTINE event__disable_field(varname)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+
+    IF (using_server) THEN
+      CALL create_request(event_id_disable_field)
+      CALL pack_data(len(varname))
+      CALL pack_data(varname)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__disable_field(varname)
+    ENDIF
+    
+  END SUBROUTINE event__disable_field
+  
+  SUBROUTINE event__write_field1d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field1d)
+      CALL pack_data(len(varname))
+      CALL pack_data(size(var,1))
+      CALL pack_data(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field1d(varname,var)
+    ENDIF
+    
+  END SUBROUTINE event__write_field1d
+
+  SUBROUTINE event__write_field2d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:,:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field2d)
+      CALL pack_data(len(varname))
+      CALL pack_data(size(var,1))
+      CALL pack_data(size(var,2))
+      CALL pack_data(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field2d(varname,var)
+    ENDIF
+    
+  END SUBROUTINE event__write_field2d
+  
+  SUBROUTINE event__write_field3d(varname,var)
+  USE iomanager
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN)     :: varname
+    REAL, DIMENSION(:,:,:),INTENT(IN) :: var
+
+    IF (using_server) THEN
+      CALL create_request(event_id_write_field3d)
+      CALL pack_data(len(varname))
+      CALL pack_data(size(var,1))
+      CALL pack_data(size(var,2))
+      CALL pack_data(size(var,3))
+      CALL pack_data(varname)
+      CALL pack_field(var)
+      CALL Finalize_request 
+    ELSE
+      CALL iom__write_field3d(varname,var)
+    ENDIF
+  END SUBROUTINE event__write_field3d
+  
+
+  SUBROUTINE event__set_timestep(timestep)
+  USE iomanager
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: timestep
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_set_timestep)
+      CALL pack_data(timestep)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_timestep(timestep)
+    ENDIF
+
+  END SUBROUTINE event__set_timestep
+    
+    
+  SUBROUTINE event__close_io_definition
+  USE iomanager
+  IMPLICIT NONE
+    
+    IF (using_server) THEN
+      CALL create_request(event_id_close_io_definition)
+      CALL Finalize_request
+    ELSE
+      CALL iom__close_io_definition
+    ENDIF
+
+  END SUBROUTINE event__close_io_definition
+
+  
+  SUBROUTINE event__set_attribut(id,attrib)
+  USE iomanager
+  USE mod_attribut
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN)   :: attrib
+ 
+    IF (using_server) THEN
+      CALL create_request(event_id_set_attribut)
+      CALL pack_data(len(id))
+      CALL pack_data(id)
+      CALL pack_data(attrib)
+      CALL Finalize_request
+    ELSE
+      CALL iom__set_attribut(id,attrib)
+    ENDIF
+ 
+  END SUBROUTINE event__set_attribut  
+
+  SUBROUTINE event__stop_ioserver
+  USE iomanager
+  IMPLICIT NONE
+ 
+    IF (using_server) THEN
+      CALL create_request(event_id_stop_ioserver)
+      is_last_request=.TRUE.
+      CALL Finalize_request
+    ELSE
+      CALL iom__finalize
+    ENDIF
+
+  END SUBROUTINE event__stop_ioserver
+    
+  
+END MODULE mod_event_client
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_parameters.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_parameters.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_parameters.f90	(revision 2354)
@@ -0,0 +1,21 @@
+MODULE mod_event_parameters
+  INTEGER, PARAMETER :: event_id_parse_xml_file        = 100
+  INTEGER, PARAMETER :: event_id_set_local_domain      = 101
+  INTEGER, PARAMETER :: event_id_set_vert_axis         = 102
+  INTEGER, PARAMETER :: event_id_set_time_parameters   = 103
+  INTEGER, PARAMETER :: event_id_set_timestep          = 104
+  INTEGER, PARAMETER :: event_id_write_field2d         = 105
+  INTEGER, PARAMETER :: event_id_write_field3d         = 106
+  INTEGER, PARAMETER :: event_id_close_io_definition   = 107
+  INTEGER, PARAMETER :: event_id_set_grid_dimension    = 108
+  INTEGER, PARAMETER :: event_id_set_grid_domain       = 109
+  INTEGER, PARAMETER :: event_id_set_grid_type_nemo    = 110
+  INTEGER, PARAMETER :: event_id_enable_field          = 111
+  INTEGER, PARAMETER :: event_id_disable_field         = 112
+  INTEGER, PARAMETER :: event_id_swap_context          = 113
+  INTEGER, PARAMETER :: event_id_set_grid_type_lmdz    = 114
+  INTEGER, PARAMETER :: event_id_write_field1d         = 115
+  INTEGER, PARAMETER :: event_id_set_attribut          = 116
+  INTEGER, PARAMETER :: event_id_set_calendar          = 117
+  INTEGER, PARAMETER :: event_id_stop_ioserver         = 999
+END MODULE mod_event_parameters
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_event_server.f90	(revision 2354)
@@ -0,0 +1,465 @@
+MODULE mod_event_server
+  USE mod_pack, ONLY : unpack_data, unpack_field
+  USE mod_event_parameters
+  USE iomanager
+  
+CONTAINS
+
+  SUBROUTINE Process_event(current_rank,is_terminated)
+  IMPLICIT NONE
+    INTEGER :: event_id
+    INTEGER, INTENT(IN) :: current_rank
+    LOGICAL,INTENT(OUT) :: is_terminated
+     
+    CALL iom__set_current_rank(current_rank)
+     
+    is_terminated=.FALSE.
+    
+    CALL unpack_data(event_id)
+    
+    SELECT CASE (event_id)
+    
+      CASE (event_id_swap_context)
+        CALL event__swap_context
+        
+      CASE (event_id_parse_xml_file)
+        CALL event__parse_xml_file 
+
+      CASE (event_id_set_vert_axis)
+        CALL event__set_vert_axis 
+     
+      CASE (event_id_set_grid_dimension)
+        CALL event__set_grid_dimension
+      
+      CASE (event_id_set_grid_domain)
+        CALL event__set_grid_domain
+
+      CASE (event_id_set_grid_type_nemo)
+        CALL event__set_grid_type_nemo
+
+      CASE (event_id_set_grid_type_lmdz)
+        CALL event__set_grid_type_lmdz
+
+      CASE (event_id_set_time_parameters)
+        CALL event__set_time_parameters
+
+      CASE (event_id_close_io_definition)
+        CALL event__close_io_definition  
+
+      CASE (event_id_set_timestep)
+        CALL event__set_timestep
+
+      CASE (event_id_set_calendar)
+        CALL event__set_calendar
+
+      CASE (event_id_enable_field)
+        CALL event__enable_field
+      
+      CASE (event_id_disable_field)
+        CALL event__disable_field
+
+      CASE (event_id_write_Field1d)
+        CALL event__write_Field1d
+
+      CASE (event_id_write_Field2d)
+        CALL event__write_Field2d
+
+      CASE (event_id_write_Field3d)
+        CALL event__write_Field3d
+
+      CASE (event_id_set_attribut)
+        CALL event__set_attribut
+
+      CASE (event_id_stop_ioserver)
+        is_terminated=.TRUE.  
+        PRINT *,"TERMINATE_EVENT RECEIVED"
+        
+
+      CASE DEFAULT 
+        STOP 'UNDEFINED EVENT'
+      
+     END SELECT
+     
+   END SUBROUTINE Process_event
+   
+  SUBROUTINE event__swap_context
+  IMPLICIT NONE
+    INTEGER :: id_size
+   
+    CALL unpack_data(id_size)
+    CALL sub_internal(id_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(id_size)
+      INTEGER :: id_size
+      CHARACTER(LEN=id_size) :: id     
+     
+       CALL unpack_data(id)
+     
+       CALL iom__swap_context(id)
+       
+     END SUBROUTINE sub_internal
+  
+  END SUBROUTINE event__swap_context
+  
+
+  SUBROUTINE event__parse_xml_file
+  IMPLICIT NONE
+    INTEGER :: name_size
+   
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: filename     
+     
+       CALL unpack_data(filename)
+     
+       CALL iom__parse_xml_file(filename)
+     END SUBROUTINE sub_internal
+  
+  END SUBROUTINE event__parse_xml_file
+  
+  
+  SUBROUTINE event__set_grid_dimension
+  IMPLICIT NONE    
+    INTEGER :: name_size
+    INTEGER :: ni_glo
+    INTEGER :: nj_glo
+   
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack_data(name)
+       CALL unpack_data(ni_glo)
+       CALL unpack_data(nj_glo)
+     
+       CALL iom__set_grid_dimension(name,ni_glo,nj_glo)
+     END SUBROUTINE sub_internal
+   
+   END SUBROUTINE event__set_grid_dimension
+
+
+  SUBROUTINE event__set_grid_domain 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: jbegin
+    REAL,ALLOCATABLE :: lon(:,:)
+    REAL,ALLOCATABLE :: lat(:,:)
+
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack_data(name)
+    
+       CALL unpack_data(ni)
+       CALL unpack_data(nj)
+       CALL unpack_data(ibegin)
+       CALL unpack_data(jbegin)
+    
+       ALLOCATE(lon(ni,nj))
+       ALLOCATE(lat(ni,nj))
+       CALL unpack_data(lon)
+       CALL unpack_data(lat)
+    
+       CALL iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_domain   
+
+
+  SUBROUTINE event__set_grid_type_nemo 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+     
+       CALL unpack_data(name)
+       CALL iom__set_grid_type_nemo(name)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_type_nemo   
+
+  SUBROUTINE event__set_grid_type_lmdz 
+  IMPLICIT NONE    
+    INTEGER :: name_size
+
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+     
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name     
+      INTEGER                  :: nbp
+      INTEGER                  :: offset
+      
+       CALL unpack_data(name)
+       CALL unpack_data(nbp)
+       CALL unpack_data(offset)
+       CALL iom__set_grid_type_lmdz(name,nbp,offset)
+
+     END SUBROUTINE sub_internal
+   
+  END SUBROUTINE event__set_grid_type_lmdz   
+
+  SUBROUTINE event__set_vert_axis
+  IMPLICIT NONE
+    INTEGER :: name_size
+    INTEGER :: vert_size 
+    REAL,ALLOCATABLE :: vert_value(:)
+    
+    CALL unpack_data(name_size)
+    CALL sub_internal(name_size)
+
+  CONTAINS
+    
+    SUBROUTINE sub_internal(name_size)
+      INTEGER :: name_size
+      CHARACTER(LEN=name_size) :: name
+    
+      CALL unpack_data(name)
+      CALL unpack_data(vert_size)
+      ALLOCATE(vert_value(vert_size))
+      CALL unpack_data(vert_value) 
+      
+      CALL iom__set_vert_axis(name,vert_value)
+      
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_vert_axis
+
+  SUBROUTINE event__set_time_parameters
+  IMPLICIT NONE
+    INTEGER   :: itau0
+    REAL      :: zjulian
+    REAL      :: zdt
+      
+    CALL unpack_data(itau0)
+    CALL unpack_data(zjulian)
+    CALL unpack_data(zdt)
+    
+    CALL iom__set_time_parameters(itau0,zjulian,zdt)
+     
+  END SUBROUTINE event__set_time_parameters
+  
+
+  SUBROUTINE event__enable_field
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack_data(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: varname
+      
+      CALL unpack_data(varname)
+      
+      CALL iom__enable_field(varname)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__enable_field
+  
+
+  SUBROUTINE event__disable_field
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack_data(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: varname
+      
+      CALL unpack_data(varname)
+      
+      CALL iom__disable_field(varname)
+
+    END SUBROUTINE sub_internal
+    
+  END SUBROUTINE event__disable_field
+  
+      
+  SUBROUTINE event__write_field1D
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+      
+    CALL unpack_data(lenc)
+    CALL unpack_data(dim1)
+    CALL sub_internal(lenc,dim1)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc,dim1)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1)
+      
+      CALL unpack_data(varname)
+      CALL unpack_field(var)
+      
+      CALL iom__write_Field1d(varname,var)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__write_field1d
+
+  SUBROUTINE event__write_field2D
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+    INTEGER :: dim2
+      
+    CALL unpack_data(lenc)
+    CALL unpack_data(dim1)
+    CALL unpack_data(dim2)
+    CALL sub_internal(lenc,dim1,dim2)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc,dim1,dim2)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      INTEGER :: dim2
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1,dim2)
+      
+      CALL unpack_data(varname)
+      CALL unpack_field(var)
+      
+      CALL iom__write_Field2d(varname,var)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__write_field2d
+    
+    
+  SUBROUTINE event__write_field3d
+  IMPLICIT NONE
+    INTEGER :: lenc
+    INTEGER :: dim1
+    INTEGER :: dim2
+    INTEGER :: dim3
+    
+    CALL unpack_data(lenc)
+    CALL unpack_data(dim1)
+    CALL unpack_data(dim2)
+    CALL unpack_data(dim3)
+    CALL sub_internal(lenc,dim1,dim2,dim3)
+ 
+  CONTAINS
+ 
+    SUBROUTINE sub_internal(lenc,dim1,dim2,dim3)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      INTEGER :: dim1
+      INTEGER :: dim2
+      INTEGER :: dim3
+ 
+      CHARACTER(len=lenc) :: varname
+      REAL                :: var(dim1,dim2,dim3)
+        
+      CALL unpack_data(varname)
+      CALL unpack_field(var)
+       
+      CALL iom__write_field3d(varname,var)
+         
+    END SUBROUTINE sub_internal
+
+  END SUBROUTINE event__write_field3d
+    
+    
+  SUBROUTINE event__set_timestep
+  IMPLICIT NONE
+    INTEGER :: timestep
+     
+    CALL unpack_data(timestep)
+    CALL iom__set_timestep(timestep)
+    
+  END SUBROUTINE event__set_timestep
+    
+
+  SUBROUTINE event__set_calendar
+  IMPLICIT NONE
+    INTEGER :: lenc
+      
+    CALL unpack_data(lenc)
+    CALL sub_internal(lenc)
+  
+  CONTAINS
+    SUBROUTINE sub_internal(lenc)
+    IMPLICIT NONE
+      INTEGER :: lenc
+      CHARACTER(len=lenc) :: str_calendar
+      
+      CALL unpack_data(str_calendar)
+      
+      CALL iom__set_calendar(str_calendar)
+
+    END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_calendar
+  
+    
+  SUBROUTINE event__close_io_definition
+  IMPLICIT NONE
+    
+    CALL iom__close_io_definition
+    
+  END SUBROUTINE event__close_io_definition
+  
+  SUBROUTINE event__set_attribut
+   USE mod_attribut
+   IMPLICIT NONE
+     TYPE(attribut) :: attrib
+     INTEGER        :: len_id
+     
+     CALL unpack_data(len_id)
+     CALL sub_internal
+   CONTAINS
+      
+     SUBROUTINE sub_internal
+       CHARACTER(LEN=len_id) :: id
+       
+       CALL unpack_data(id)
+       CALL unpack_data(attrib)
+       CALL iom__set_attribut(id,attrib)
+       CALL attr_deallocate(attrib)
+     END SUBROUTINE sub_internal
+  END SUBROUTINE event__set_attribut    
+
+END MODULE mod_event_server   
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_field_bufferize.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_field_bufferize.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_field_bufferize.f90	(revision 2354)
@@ -0,0 +1,94 @@
+MODULE field_bufferize
+  
+  INTEGER,SAVE      :: nx=0
+  INTEGER,SAVE      :: ny=0
+  INTEGER,SAVE      :: nz=0
+    
+  REAL,POINTER,SAVE :: field_buffer(:,:,:)
+  
+
+  
+CONTAINS
+
+  SUBROUTINE bufferize_field(ni,ibegin,nj,jbegin,nk,kbegin,nbp,field,i_index,j_index,mask)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: jbegin
+    INTEGER,INTENT(IN) :: nk
+    INTEGER,INTENT(IN) :: kbegin
+    INTEGER,INTENT(IN) :: nbp
+    REAL,INTENT(IN)    :: field(nbp,nk)
+    INTEGER,INTENT(IN) :: i_index(nbp)
+    INTEGER,INTENT(IN) :: j_index(nbp)
+    LOGICAL,INTENT(IN),OPTIONAL :: mask(nbp)  
+    
+    INTEGER :: iend
+    INTEGER :: jend
+    INTEGER :: kend 
+
+    LOGICAL      :: need_reallocate
+    REAL,POINTER :: tmp_buffer(:,:,:)
+    INTEGER      :: i,j,k,n
+    
+    iend=ibegin+ni-1
+    jend=jbegin+nj-1
+    kend=kbegin+nk-1
+    
+    IF (PRESENT(mask)) THEN
+      DO k=kbegin,kend
+        DO n=1,nbp
+          i=i_index(n)+ibegin-1
+          j=j_index(n)+jbegin-1
+          IF (mask(n)) field_buffer(i,j,k)=field(n,k)
+        ENDDO
+      ENDDO
+    ELSE
+      DO k=kbegin,kend
+        DO n=1,nbp
+          i=i_index(n)+ibegin-1
+          j=j_index(n)+jbegin-1
+          field_buffer(i,j,k)=field(n,k)
+        ENDDO
+      ENDDO
+    ENDIF
+    
+  END SUBROUTINE bufferize_field
+
+  SUBROUTINE Init_field_Bufferize(ni,nj,nk)
+  IMPLICIT NONE
+  INTEGER,INTENT(IN) :: ni
+  INTEGER,INTENT(IN) :: nj
+  INTEGER,INTENT(IN) :: nk
+     
+    LOGICAL :: need_reallocate
+    
+    
+    need_reallocate=.FALSE.
+    
+    IF ( ni > nx) THEN
+      nx=ni
+      need_reallocate=.TRUE.
+    ENDIF
+    
+    IF ( nj > ny) THEN
+      ny=nj
+      need_reallocate=.TRUE.
+    ENDIF
+
+    IF ( nk > nz) THEN
+      nz=nk
+      need_reallocate=.TRUE.
+    ENDIF
+    
+    IF (need_reallocate) THEN
+      IF (ASSOCIATED(field_buffer)) DEALLOCATE(field_buffer)
+      ALLOCATE(field_buffer(nx,ny,nz))
+    ENDIF
+
+    field_buffer(1:nx,1:ny,1:nz)=0.
+
+  END SUBROUTINE  init_field_bufferize         
+
+END MODULE field_bufferize
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_global_memory.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_global_memory.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_global_memory.f90	(revision 2354)
@@ -0,0 +1,123 @@
+MODULE mod_global_memory
+
+  INTERFACE allocate_global_memory
+    MODULE PROCEDURE Allocate_global_memory_r8,    &
+                     Allocate_global_memory_i8,    &
+!                     Allocate_global_memory_r4,    &
+                     Allocate_global_memory_i4
+  END INTERFACE Allocate_global_memory
+  
+CONTAINS
+
+  SUBROUTINE Allocate_global_memory_r8(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    REAL(kind=8),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    REAL(kind=8) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=8*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      REAL(kind=8),DIMENSION(:),target :: MPI_Buffer
+      REAL(kind=8),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_r8
+
+
+
+  SUBROUTINE Allocate_global_memory_i8(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER(kind=8),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    INTEGER(kind=8) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=8*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      INTEGER(kind=8),DIMENSION(:),target :: MPI_Buffer
+      INTEGER(kind=8),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_i8
+  
+  
+!  SUBROUTINE Allocate_global_memory_r4(size,Pt)
+!  USE mpi_mod
+!  IMPLICIT NONE
+!    REAL(kind=4),POINTER :: Pt(:)
+!    INTEGER              :: size
+!
+!    POINTER (Pbuffer,MPI_Buffer(size))
+!    REAL(kind=4) :: MPI_Buffer
+!    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+!    INTEGER :: ierr
+!    
+!    BS=4*size
+!    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+!    CALL associate_buffer(MPI_Buffer,Pt)
+!  
+!  CONTAINS
+!  
+!    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+!    IMPLICIT NONE
+!      REAL(kind=4),DIMENSION(:),target :: MPI_Buffer
+!      REAL(kind=4),POINTER             :: Pt(:)
+!      Pt=>MPI_buffer
+!    END SUBROUTINE associate_buffer
+!  
+!  END SUBROUTINE Allocate_global_memory_r4
+
+
+
+
+  SUBROUTINE Allocate_global_memory_i4(size,Pt)
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER(kind=4),POINTER :: Pt(:)
+    INTEGER              :: size
+
+    POINTER (Pbuffer,MPI_Buffer(size))
+    INTEGER(kind=4) :: MPI_Buffer
+    INTEGER(KIND=MPI_ADDRESS_KIND) :: BS 
+    INTEGER :: ierr
+    
+    BS=4*size
+    CALL MPI_ALLOC_MEM(BS,MPI_INFO_NULL,Pbuffer,ierr)
+    CALL associate_buffer(MPI_Buffer,Pt)
+  
+  CONTAINS
+  
+    SUBROUTINE associate_buffer(MPI_buffer,Pt)
+    IMPLICIT NONE
+      INTEGER(kind=4),DIMENSION(:),target :: MPI_Buffer
+      INTEGER(kind=4),POINTER             :: Pt(:)
+      Pt=>MPI_buffer
+    END SUBROUTINE associate_buffer
+  
+  END SUBROUTINE Allocate_global_memory_i4
+  
+  
+END MODULE mod_global_memory
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_interface_ioipsl.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_interface_ioipsl.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_interface_ioipsl.f90	(revision 2354)
@@ -0,0 +1,272 @@
+MODULE mod_interface_ioipsl
+
+ 
+  INTEGER,PARAMETER     :: id_file=1
+
+
+CONTAINS
+
+  SUBROUTINE init_interface_ioipsl
+  USE xmlio
+  IMPLICIT NONE
+  
+    
+  END SUBROUTINE init_interface_ioipsl
+
+  SUBROUTINE set_calendar(str_calendar)
+  USE ioipsl
+    CHARACTER(LEN=*) :: str_calendar
+    
+    CALL ioconf_calendar(str_calendar)
+    
+  END SUBROUTINE set_calendar
+  
+  
+  SUBROUTINE set_time_parameters(ini_timestep0,zjulian0,timestep0)
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER :: ini_timestep0
+    REAL :: zjulian0, timestep0
+
+    timestep_value=timestep0
+    initial_timestep=ini_timestep0
+    initial_date=zjulian0
+
+  END SUBROUTINE set_time_parameters
+
+  SUBROUTINE Create_file_definition(nb_server,server_rank)
+  USE ioipsl
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER,INTENT(IN)  :: nb_server
+    INTEGER,INTENT(IN)  :: server_rank
+    
+    TYPE(file_dep),POINTER :: pt_file_dep
+    TYPE(file),POINTER     :: pt_file
+    TYPE(field),POINTER    :: pt_field
+    TYPE(grid),POINTER     :: pt_grid
+    TYPE(zoom),POINTER     :: pt_zoom
+    TYPE(axis),POINTER     :: pt_axis
+    TYPE(domain),POINTER   :: pt_domain
+
+    TYPE(sorted_list),POINTER :: axis_id
+    LOGICAL :: found                  
+    INTEGER :: ioipsl_axis_id
+    INTEGER :: ioipsl_file_id
+    INTEGER :: ioipsl_hori_id
+    INTEGER :: ioipsl_domain_id
+    INTEGER :: i,j
+    CHARACTER(LEN=20) :: direction
+    CHARACTER(LEN=255) :: full_name
+    CALL xmlio__close_definition 
+    
+    ALLOCATE(axis_id)
+    
+    DO i=1,file_enabled%size
+      
+      pt_file_dep=>file_enabled%at(i)%pt
+
+      IF (pt_file_dep%fields%size>0) THEN
+        CALL sorted_list__new(axis_id)
+
+        pt_file=>pt_file_dep%file
+      
+        pt_grid=>pt_file_dep%grids%at(1)%pt
+        pt_domain=>pt_grid%domain
+        pt_zoom=>pt_file_dep%zooms%at(1)%pt
+!        print *,TRIM(pt_file%name),' ',TRIM(pt_zoom%id)
+!        print*,'Global --->',pt_zoom%ni_glo,pt_zoom%nj_glo,pt_zoom%ibegin_glo,pt_zoom%jbegin_glo
+!        print*,'Local  --->',pt_zoom%ni_loc,pt_zoom%nj_loc,pt_zoom%ibegin_loc,pt_zoom%jbegin_loc
+      
+        IF (pt_zoom%ni_loc*pt_zoom%nj_loc > 0) THEN
+        
+          full_name=TRIM(pt_file%name)
+          IF (pt_file%has_name_suffix) full_name=TRIM(full_name)//TRIM(pt_file%name_suffix) 
+          IF ( (pt_zoom%ni_loc == pt_zoom%ni_glo) .AND. (pt_zoom%nj_loc == pt_zoom%nj_glo) ) THEN 
+
+            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat, & 
+                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,         &
+                       initial_timestep, initial_date, timestep_value,                               &
+                       ioipsl_hori_id, ioipsl_file_id)
+           ELSE                                              
+
+            CALL set_ioipsl_domain_id(pt_grid,nb_server,server_rank,ioipsl_domain_id)
+            CALL histbeg(TRIM(full_name),pt_domain%ni,pt_domain%lon, pt_domain%nj, pt_domain%lat,  &
+                       pt_zoom%ibegin_loc, pt_zoom%ni_loc,pt_zoom%jbegin_loc,pt_zoom%nj_loc,          &
+                       initial_timestep, initial_date, timestep_value,                                &
+                       ioipsl_hori_id, ioipsl_file_id,domain_id=ioipsl_domain_id)                                              
+          
+           ENDIF
+        
+      
+          DO j=1,pt_file_dep%axis%size
+            pt_axis=>pt_file_dep%axis%at(j)%pt
+            CALL sorted_list__find(axis_id,hash(Pt_axis%name),ioipsl_axis_id,found)
+            IF (.NOT. found) THEN
+              IF (TRIM(pt_axis%name) /= "none") THEN
+              
+                IF (pt_axis%has_positive) THEN 
+                  IF (pt_axis%positive) THEN
+                    direction="up"
+                  ELSE
+                    direction="down"
+                  ENDIF
+                ELSE
+                  direction='unknown'
+                ENDIF
+
+                CALL histvert(ioipsl_file_id, TRIM(pt_axis%name),TRIM(pt_axis%description),    &
+                             TRIM(pt_axis%unit), pt_axis%size,pt_axis%values, ioipsl_axis_id,  &
+                           pdirect=direction)
+                CALL sorted_list__add(axis_id,hash(Pt_axis%name),ioipsl_axis_id)
+              ENDIF
+            ENDIF
+         ENDDO
+        
+          DO j=1,pt_file_dep%fields%size
+            pt_field=>pt_file_dep%fields%at(j)%pt
+            IF (pt_field%axis%name=="none") THEN
+              pt_field%internal(id_file)=ioipsl_file_id
+              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,            &
+                        &  pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,      &
+                        &  ioipsl_hori_id, 1, 1, 1, -99, 32, pt_field%operation,                 &
+                        &  real(pt_field%freq_op), real(pt_file%output_freq) )
+            ELSE
+              pt_field%internal(id_file)=ioipsl_file_id
+              CALL sorted_list__find(axis_id,hash(Pt_field%axis%name),ioipsl_axis_id,found)
+              CALL histdef(ioipsl_file_id, TRIM(pt_field%name), pt_field%description,          &
+                         & pt_field%unit, pt_field%grid%domain%ni, pt_field%grid%domain%nj,    &
+                         & ioipsl_hori_id, pt_field%axis%size, 1, pt_field%axis%size,          &
+                         & ioipsl_axis_id, 32, pt_field%operation, real(pt_field%freq_op),     &
+                         & real(pt_file%output_freq) )
+            ENDIF
+          ENDDO
+          CALL histend(ioipsl_file_id)
+        ENDIF
+        CALL sorted_list__delete(axis_id)
+      ENDIF
+    ENDDO
+    
+    DEALLOCATE(axis_id)
+     
+  END SUBROUTINE Create_file_definition  
+
+
+
+   SUBROUTINE write_ioipsl_2d(varname,var)
+   USE ioipsl
+   USE xmlio
+   IMPLICIT NONE
+     CHARACTER(len=*),INTENT(IN) :: varname
+     REAL            ,INTENT(IN) :: var(:,:)
+     
+     TYPE(field_dep),POINTER :: pt_field_base
+     TYPE(field)    ,POINTER :: pt_field
+     INTEGER :: nindex(size(var))
+     INTEGER :: ioipsl_file_id
+     INTEGER :: pos
+     LOGICAL :: found
+     INTEGER :: i
+      
+     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
+
+     IF (found) THEN
+       pt_field_base=>field_id%at(pos)%pt
+     
+       DO i=1,pt_field_base%field_out%size
+         pt_field=>pt_field_base%field_out%at(i)%pt%field
+         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
+           ioipsl_file_id=pt_field%internal(id_file)
+           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
+         ENDIF
+       ENDDO
+     ENDIF
+     
+   END SUBROUTINE write_ioipsl_2d
+       
+     
+   SUBROUTINE write_ioipsl_3d(varname,var)
+   USE ioipsl
+   USE xmlio
+   IMPLICIT NONE
+     CHARACTER(len=*),INTENT(IN) :: varname
+     REAL            ,INTENT(IN) :: var(:,:,:)
+     
+     TYPE(field_dep),POINTER :: pt_field_base
+     TYPE(field)    ,POINTER :: pt_field
+     INTEGER :: nindex(size(var))
+     INTEGER :: ioipsl_file_id
+     INTEGER :: pos
+     LOGICAL :: found
+     INTEGER :: i
+        
+     CALL sorted_list__find(sorted_id,hash(varname),pos,found)
+
+     IF (found) THEN
+       pt_field_base=>field_id%at(pos)%pt
+     
+       DO i=1,pt_field_base%field_out%size
+         pt_field=>pt_field_base%field_out%at(i)%pt%field
+         IF ( pt_field%zoom%ni_loc * pt_field%zoom%nj_loc > 0) THEN           
+           ioipsl_file_id=pt_field%internal(id_file)
+           CALL histwrite(ioipsl_file_id, TRIM(pt_field%name), timestep_number, var, size(var), nindex)
+         ENDIF
+       ENDDO
+     ENDIF
+   END SUBROUTINE write_ioipsl_3d
+           
+
+  SUBROUTINE set_timestep(timestep_nb0)
+  USE xmlio
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: timestep_nb0
+     
+    timestep_number=timestep_nb0
+
+  END SUBROUTINE set_timestep
+
+
+  SUBROUTINE set_ioipsl_domain_id(pt_grid, nb_server,server_rank,domain_id)
+  USE xmlio
+  USE mod_ioserver_para
+  USE ioipsl
+  IMPLICIT NONE
+    TYPE(grid), POINTER :: pt_grid
+    INTEGER,INTENT(IN)  :: nb_server
+    INTEGER,INTENT(IN)  :: server_rank
+    INTEGER,INTENT(OUT) :: domain_id
+    TYPE(domain), POINTER :: pt_domain
+               
+    INTEGER,DIMENSION(2) :: ddid
+    INTEGER,DIMENSION(2) :: dsg
+    INTEGER,DIMENSION(2) :: dsl
+    INTEGER,DIMENSION(2) :: dpf
+    INTEGER,DIMENSION(2) :: dpl
+    INTEGER,DIMENSION(2) :: dhs
+    INTEGER,DIMENSION(2) :: dhe 
+    
+    pt_domain=>pt_grid%domain
+
+    ddid = (/ 1,2 /)
+    dsg  = (/ pt_grid%ni, pt_grid%nj /)
+    dsl  = (/ pt_domain%ni, pt_domain%nj /)
+    dpf  = (/ pt_domain%ibegin,pt_domain%jbegin /)
+    dpl  = (/ pt_domain%iend, pt_domain%jend /)
+    dhs  = (/ 0,0 /)
+    dhe  = (/ 0,0 /)
+    
+    call flio_dom_set(nb_server,server_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
+                      'BOX',domain_id)
+  
+  END SUBROUTINE set_ioipsl_domain_id
+
+
+  SUBROUTINE ioipsl_finalize
+  USE ioipsl
+  IMPLICIT NONE
+
+    CALL histclo
+    
+  END SUBROUTINE ioipsl_finalize
+  
+END MODULE mod_interface_ioipsl
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient.f90	(revision 2354)
@@ -0,0 +1,61 @@
+MODULE mod_ioclient
+
+
+CONTAINS
+
+  SUBROUTINE init_ioclient(NEW_COMM)
+  USE mod_ioclient_para
+  USE mod_mpi_buffer_client
+  USE mod_wait
+  USE mod_ioserver_namelist
+  USE mod_event_client
+  USE iomanager
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER, INTENT(INOUT),OPTIONAL :: NEW_COMM
+
+    INTEGER :: Comm
+    INTEGER :: nb_server
+    INTEGER :: rank
+    INTEGER :: ierr
+    LOGICAL :: init
+ 
+    CALL read_namelist
+
+    IF (using_mpi) THEN
+      IF (using_server) THEN
+        CALL Init_parallel
+        CALL Init_mpi_buffer
+        CALL Init_wait
+        IF (PRESENT(NEW_COMM)) THEN
+          NEW_COMM=intracomm
+        ENDIF
+      ELSE
+        CALL MPI_INITIALIZED(init,ierr)
+        IF (init) THEN
+          IF (.NOT. PRESENT(NEW_COMM)) THEN
+             Comm=MPI_COMM_WORLD
+          ELSE
+            Comm=New_Comm
+          ENDIF
+        ELSE
+          CALL MPI_INIT(ierr)
+          Comm=MPI_COMM_WORLD
+          
+          IF (PRESENT(NEW_COMM)) THEN
+            New_Comm=MPI_COMM_WORLD
+          ENDIF
+        ENDIF  
+        CALL MPI_COMM_SIZE(Comm,nb_server,ierr)     
+        CALL MPI_COMM_RANK(Comm,rank,ierr)
+        CALL iom__init(1,nb_server,rank)
+        CALL iom__set_current_rank(1)
+      ENDIF
+    ELSE
+      CALL iom__init(1,1,0)
+      CALL iom__set_current_rank(1)
+    ENDIF
+    
+  END SUBROUTINE init_ioclient
+
+END MODULE mod_ioclient
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient_para.F90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient_para.F90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioclient_para.F90	(revision 2354)
@@ -0,0 +1,89 @@
+  MODULE mod_ioclient_para
+    INTEGER,PARAMETER :: color_client=1
+    INTEGER,PARAMETER :: color_server=2 
+    INTEGER,SAVE      :: iocomm
+    INTEGER,SAVE      :: iosize
+    INTEGER,SAVE      :: iorank
+    INTEGER,SAVE      :: server_rank
+    INTEGER,SAVE      :: intracomm 
+  CONTAINS
+  
+  
+  SUBROUTINE Init_parallel
+  USE mpitrace
+  USE mod_ioserver_namelist
+#ifdef USE_OASIS
+  USE mod_prism_get_comm  
+#endif
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: NEW_COMM
+    INTEGER :: ierr
+    INTEGER :: global_rank
+    INTEGER :: global_size
+    INTEGER :: mpi_rank
+    INTEGER :: mpi_size
+    INTEGER :: nb_server_io  
+    INTEGER,ALLOCATABLE :: proc_color(:) 
+    INTEGER :: i
+    INTEGER :: div,remain
+    INTEGER :: group_color
+    INTEGER :: Comm_client_server
+    CHARACTER(LEN=6) :: oasis_server_id
+    
+    IF (using_oasis) THEN
+      oasis_server_id=server_id
+      PRINT *,'prism_get_intracomm'
+#ifdef USE_OASIS
+      CALL prism_get_intracomm(Comm_client_server,oasis_server_id,ierr)
+#endif
+    ELSE
+      CALL MPI_INIT(ierr)
+      Comm_client_server=MPI_COMM_WORLD
+    ENDIF
+
+    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
+    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,color_client,global_rank,intracomm,ierr)
+    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
+    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
+
+    nb_server_io=global_size-mpi_size
+    div=mpi_size/nb_server_io
+    remain=MOD(mpi_size,nb_server_io)
+    
+    IF (mpi_rank<remain*(div+1)) THEN
+      group_color=mpi_rank/(div+1)
+    ELSE
+      group_color=(nb_server_io-1)-(mpi_size-1-mpi_rank)/div
+    ENDIF
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)
+    
+    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
+    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
+
+    ALLOCATE(proc_color(0:iosize-1))
+    CALL MPI_ALLGATHER(color_client,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
+    
+    DO i=0,iosize-1
+      IF (proc_color(i)==color_server) THEN
+        server_rank=i
+        EXIT
+      ENDIF
+    ENDDO
+    
+    PRINT *,"Proces No",mpi_rank,"--> server",server_rank
+  END SUBROUTINE Init_parallel
+  
+  SUBROUTINE Finalize_parallel
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    
+    CALL MPI_FINALIZE(ierr)
+
+  END SUBROUTINE Finalize_parallel
+  
+  END MODULE mod_ioclient_para
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_iomanager.f90	(revision 2354)
@@ -0,0 +1,435 @@
+MODULE iomanager
+  INTEGER,PRIVATE,SAVE :: nb_client
+  INTEGER,PRIVATE,SAVE :: nb_server
+  INTEGER,PRIVATE,SAVE :: server_rank
+  INTEGER,PRIVATE,SAVE :: current_rank
+  
+CONTAINS
+
+  SUBROUTINE iom__init(nb_client_,nb_server_,server_rank_)
+  IMPLICIT NONE
+   INTEGER,INTENT(IN) :: nb_client_
+   INTEGER,INTENT(IN) :: nb_server_
+   INTEGER,INTENT(IN) :: server_rank_
+   
+     nb_client=nb_client_ 
+     nb_server=nb_server_
+     server_rank=server_rank_
+     
+  END SUBROUTINE iom__init
+ 
+  SUBROUTINE iom__parse_xml_file(filename)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: filename
+    
+    IF (current_rank==nb_client) CALL xmlio__init(filename)
+     
+  END SUBROUTINE iom__parse_xml_file
+   
+  SUBROUTINE iom__swap_context(id)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: id
+    
+    IF (current_rank==nb_client) CALL context__swap(id)
+     
+  END SUBROUTINE iom__swap_context
+
+  SUBROUTINE iom__set_current_rank(rank)
+  IMPLICIT NONE
+    INTEGER,INTENT(IN) :: rank
+    
+    current_rank=rank
+  
+  END SUBROUTINE iom__set_current_rank
+  
+  SUBROUTINE iom__set_vert_axis(name,vert_value)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    REAL,INTENT(IN)             :: vert_value(:)
+    TYPE(axis), POINTER :: pt_axis
+    
+    IF (current_rank==nb_client) THEN
+      CALL axis__get(name, pt_axis)
+      CALL axis__set(pt_axis, a_size=size(vert_value), values=vert_value)
+    ENDIF
+ 
+  END SUBROUTINE iom__set_vert_axis
+
+ 
+  SUBROUTINE iom__set_grid_dimension(name,ni_glo,nj_glo)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni_glo
+    INTEGER,INTENT(IN) :: nj_glo
+    TYPE(grid), POINTER :: pt_grid
+  
+    IF (current_rank==nb_client) THEN
+      CALL grid__get(name,pt_grid)
+      CALL grid__set_dimension(pt_grid,ni_glo,nj_glo)
+    ENDIF
+
+  END SUBROUTINE iom__set_grid_dimension
+  
+  SUBROUTINE iom__set_grid_domain(name,ni,nj,ibegin,jbegin,lon,lat)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_new_subdomain(pt_grid,current_rank,pt_domain)
+      CALL domain__set(pt_domain,current_rank,ni,nj,ibegin,jbegin,lon,lat)
+
+  END SUBROUTINE iom__set_grid_domain
+
+  SUBROUTINE iom__set_grid_type_nemo(name)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+      
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
+      CALL domain__set_type_box(pt_domain)
+
+  END SUBROUTINE iom__set_grid_type_nemo
+
+  SUBROUTINE iom__set_grid_type_lmdz(name,nbp,offset)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: name
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+
+    TYPE(grid),   POINTER :: pt_grid
+    TYPE(domain), POINTER :: pt_domain
+    LOGICAL,ALLOCATABLE   :: mask(:,:)
+      
+      CALL grid__get(name,pt_grid)
+      CALL grid__get_subdomain(pt_grid,current_rank,pt_domain)
+      ALLOCATE(mask(pt_domain%ni,pt_domain%nj))
+      mask(:,:)=.TRUE.
+      mask(1:offset,1)=.FALSE.
+      mask(MOD(offset+nbp-1,pt_domain%ni)+2:pt_domain%ni,pt_domain%nj)=.FALSE.
+      CALL domain__set_type_box(pt_domain,mask)
+
+  END SUBROUTINE iom__set_grid_type_lmdz
+      
+  SUBROUTINE iom__set_time_parameters(itau0,zjulian,zdt)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: itau0
+    REAL,INTENT(IN)     :: zjulian
+    REAL,INTENT(IN)     :: zdt
+      
+    IF (current_rank==nb_client) THEN
+      CALL set_time_parameters(itau0, zjulian, zdt)
+    ENDIF
+  END SUBROUTINE iom__set_time_parameters
+  
+  SUBROUTINE iom__close_io_definition
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+    IF (current_rank==nb_client) CALL Create_file_definition(nb_server,server_rank)
+  
+  END SUBROUTINE iom__close_io_definition
+      
+
+  SUBROUTINE iom__set_timestep(timestep)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: timestep
+    
+    IF (current_rank==nb_client) CALL set_timestep(timestep)
+    
+  END SUBROUTINE iom__set_timestep
+
+  SUBROUTINE iom__set_calendar(str_calendar)
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: str_calendar
+    
+    IF (current_rank==nb_client) CALL set_calendar(str_calendar)
+    
+  END SUBROUTINE iom__set_calendar
+
+  SUBROUTINE iom__enable_field(varname)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    TYPE(field),POINTER :: pt_field
+    
+    CALL field__get(TRIM(varname), pt_field)
+    CALL field__set(pt_field,enabled=.TRUE.)
+    
+  END SUBROUTINE iom__enable_field
+  
+  SUBROUTINE iom__disable_field(varname)
+  USE xmlio
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    TYPE(field),POINTER :: pt_field
+    
+    CALL field__get(TRIM(varname), pt_field)
+    CALL field__set(pt_field,enabled=.FALSE.)
+    
+  END SUBROUTINE iom__disable_field
+   
+
+  SUBROUTINE iom__write_field1d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,ibegin,jbegin
+    INTEGER :: id_rank
+    
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+
+    IF (subdomain%type==box) THEN
+
+      WRITE(message,*) 'Field must have 2 or 3 dimensions for box domain. There, it have only one.' 
+      CALL error("iom__write_field2d")
+
+    ELSE IF (subdomain%type==orange) THEN
+      IF (size(var,1)/=subdomain%nbp) THEN 
+         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field nbp :',size(var,1),'   grid nbp :',subdomain%nbp
+         CALL error("iom__write_field2d")
+      ENDIF
+      IF (pt_field%axis%name /= 'none') THEN
+        WRITE(message,*) "Missing axis dimension for this field"
+        CALL error("iom__write_field2d")
+      ENDIF
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,1)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,1,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
+    ENDIF
+    
+  END SUBROUTINE iom__write_field1d
+
+   
+  SUBROUTINE iom__write_field2d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:,:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,nk,ibegin,jbegin
+    INTEGER :: id_rank
+    
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+    nk=pt_field%axis%size
+
+    IF (subdomain%type==box) THEN
+      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
+        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
+        CALL error("iom__write_field2d")
+      ENDIF
+      
+      IF (pt_field%axis%name/="none") THEN
+        WRITE(message,*) "Missing axis dimension for this field"
+        CALL error("iom__write_field2d")
+      ENDIF
+    
+    ELSE IF (subdomain%type==orange) THEN
+      IF (size(var,1)/=subdomain%nbp) THEN 
+         WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field nbp :',size(var,1),'   grid nbp : ',subdomain%nbp
+         CALL error("iom__write_field2d")
+      ENDIF
+      IF (nk /= size(var,2)) THEN
+         WRITE(message,*) 'Field dimensions are not compliant with the associated axis', &
+                          'field dim :',size(var,2),'   axis dim :', nk
+         CALL error("iom__write_field2d")
+      ENDIF
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      
+      IF (pt_field%axis%name=="none") THEN
+        CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
+      ELSE 
+        CALL write_ioipsl_2d(varname,Field_buffer(1:ni,1:nj,1))
+      ENDIF
+    
+    ENDIF
+    
+  END SUBROUTINE iom__write_field2d
+
+  SUBROUTINE iom__write_field3d(varname,var)
+  USE xmlio
+  USE field_bufferize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: varname
+    REAL             :: var(:,:,:)
+
+    TYPE(field),POINTER  :: pt_field
+    TYPE(domain),POINTER :: subdomain
+    TYPE(domain),POINTER :: local_domain
+    INTEGER :: ni,nj,nk,ibegin,jbegin
+    INTEGER :: id_rank
+
+    CALL field__get(varname,pt_field)
+    id_rank=pt_field%grid%ranks(current_rank)
+    local_domain=>pt_field%grid%domain
+    
+    subdomain=>pt_field%grid%subdomain%at(id_rank)%pt
+    ni=subdomain%ni
+    nj=subdomain%nj
+    ibegin=subdomain%ibegin-local_domain%ibegin+1
+    jbegin=subdomain%jbegin-local_domain%jbegin+1 
+    nk=pt_field%axis%size
+
+    IF (subdomain%type==box) THEN
+      IF (size(var,1)/=ni .OR. size(var,2)/=nj) THEN
+        WRITE(message,*) 'Field dimensions are not compliant with the associated grid ',  &
+                          'field dim :',size(var,1),',',size(var,2),'   grid dim',ni,',',nj
+        CALL error("iom__write_field3d")
+      ENDIF
+      
+      IF (pt_field%axis%name=='none' .OR. nk/=size(var,3)) THEN
+        WRITE(message,*) 'Field dimension is not compliant with the associated axis : ', &
+                         'field dim : ',size(var,3),'  axis dim : ',nk
+        CALL error("iom__write_field3d")
+      ENDIF
+
+    ELSE IF (subdomain%type==orange) THEN
+
+      WRITE(message,*) 'Field have too much dimensions for box domain. There, it has 3.' 
+      CALL error("iom__write_field3d")
+      
+    ENDIF
+    
+    
+    IF (current_rank==1) THEN
+      CALL init_field_bufferize(local_domain%ni,local_domain%nj,nk)
+    ENDIF
+    
+    CALL bufferize_field(ni,ibegin,nj,jbegin,nk,1,subdomain%nbp,var,         &
+                         subdomain%i_index,subdomain%j_index,subdomain%mask)
+    
+    IF (current_rank==nb_client) THEN
+      ni=local_domain%ni
+      nj=local_domain%nj
+      
+      CALL write_ioipsl_3d(varname,Field_buffer(1:ni,1:nj,1:nk))
+    
+    ENDIF
+    
+  END SUBROUTINE iom__write_field3d
+ 
+  SUBROUTINE iom__Finalize
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+    IF (current_rank==nb_client) CALL ioipsl_finalize
+    
+  END SUBROUTINE iom__Finalize
+
+
+  SUBROUTINE iom__set_attribut(id,attrib)
+  USE mod_attribut
+  USE mod_object
+  USE mod_field
+  USE mod_field_group
+  USE mod_file
+  USE mod_file_group
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_grid
+  USE mod_grid_group
+  USE mod_zoom
+  IMPLICIT NONE
+    CHARACTER(LEN=*) :: id
+    TYPE(attribut)   :: attrib  
+    LOGICAL          :: success
+    IF (current_rank==nb_client) THEN
+    
+      SELECT CASE(attrib%object)
+        CASE(field_object)
+          CALL field_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL field__set_attribut(id,attrib,success)         
+        CASE(file_object)
+          CALL file_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL file__set_attribut(id,attrib,success)         
+        CASE(axis_object)
+          CALL axis_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL axis__set_attribut(id,attrib,success)         
+        CASE(grid_object)
+          CALL grid_group__set_attribut(id,attrib,success)
+          IF (.NOT. success) CALL grid__set_attribut(id,attrib,success)         
+        CASE(zoom_object)
+          CALL zoom__set_attribut(id,attrib,success)
+      END SELECT
+    ENDIF
+    
+  END SUBROUTINE iom__set_attribut
+   
+END MODULE iomanager 
+ 
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_namelist.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_namelist.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_namelist.f90	(revision 2354)
@@ -0,0 +1,61 @@
+MODULE mod_ioserver_namelist
+
+  LOGICAL,SAVE :: using_server
+  LOGICAL,SAVE :: using_oasis
+  CHARACTER(LEN=100),SAVE :: client_id
+  CHARACTER(LEN=100),SAVE :: server_id
+  NAMELIST /coupling_param/ using_server,using_oasis,client_id,server_id  
+
+  INTEGER,SAVE :: global_mpi_buffer_size            
+  NAMELIST /mpi_param/ global_mpi_buffer_size  
+
+  INTEGER,PARAMETER,PRIVATE :: starting_unit=356
+  
+CONTAINS
+
+  SUBROUTINE set_default_namelist
+  IMPLICIT NONE
+  
+    using_server=.FALSE.
+    using_oasis=.FALSE.
+    client_id='unknown'
+    server_id='unknown'
+    global_mpi_buffer_size=512
+    
+  END SUBROUTINE set_default_namelist
+  
+    
+  SUBROUTINE read_namelist
+  IMPLICIT NONE
+    LOGICAL :: opened
+    INTEGER :: unit
+    INTEGER :: ierr
+
+    CALL set_default_namelist   
+    unit=starting_unit
+    opened=.TRUE.
+    DO WHILE (opened) 
+      unit=unit+1
+      INQUIRE(unit,OPENED=opened)
+    ENDDO
+      
+    OPEN(UNIT=unit,FILE='xmlio_server.def',STATUS='old',IOSTAT=ierr)
+    
+    
+    IF (ierr==0) THEN
+      READ(unit,nml=coupling_param)
+      READ(unit,nml=mpi_param)
+      global_mpi_buffer_size=global_mpi_buffer_size*1024*128  
+      CLOSE(unit)
+    ELSE
+      PRINT *,'WARNING : mod_ioserver::read_namelist : file xmlio_server.def is absent', &
+              ' ---> using default parameter'
+    ENDIF 
+    
+    
+    PRINT *,'namelist read --> ',using_server,using_oasis,client_id,server_id
+    
+  END SUBROUTINE read_namelist
+
+
+END MODULE mod_ioserver_namelist 
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_para.F90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_para.F90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_ioserver_para.F90	(revision 2354)
@@ -0,0 +1,102 @@
+  MODULE mod_ioserver_para
+    INTEGER,PARAMETER :: color_client=1
+    INTEGER,PARAMETER :: color_server=2 
+
+    INTEGER,SAVE      :: iocomm
+    INTEGER,SAVE      :: iosize
+    INTEGER,SAVE      :: iorank
+    
+    INTEGER,SAVE      :: mpi_rank
+    INTEGER,SAVE      :: mpi_size
+    INTEGER,SAVE      :: mpi_master
+    LOGICAL,SAVE      :: is_mpi_master
+  
+    INTEGER,SAVE      :: nb_client
+    INTEGER,ALLOCATABLE,SAVE      :: client_rank(:)
+    INTEGER,SAVE      :: intracomm 
+  CONTAINS
+  
+  
+  SUBROUTINE Init_parallel
+  USE mpitrace
+  USE mod_ioserver_namelist
+#ifdef USE_OASIS
+  USE mod_prism_get_comm 
+#endif 
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    INTEGER :: global_rank
+    INTEGER :: global_size
+    INTEGER,ALLOCATABLE :: proc_color(:)
+    INTEGER :: i
+    INTEGER :: group_color
+    INTEGER :: Comm_client_server
+    INTEGER :: comp_id
+    CHARACTER(LEN=6) :: oasis_server_id, oasis_client_id
+
+    IF (using_oasis) THEN
+       oasis_server_id=server_id
+       oasis_client_id=client_id
+#ifdef USE_OASIS
+       CALL prism_init_comp_proto (comp_id, oasis_server_id, ierr)
+       CALL prism_get_intracomm(Comm_client_server,oasis_client_id,ierr)
+#endif
+    ELSE
+      CALL MPI_INIT(ierr)
+      Comm_client_server=MPI_COMM_WORLD
+    ENDIF
+        
+    CALL MPI_COMM_RANK(Comm_client_server,global_rank,ierr)
+    CALL MPI_COMM_SIZE(Comm_client_server,global_size,ierr)
+       
+    CALL MPI_COMM_SPLIT(Comm_client_server,color_server,global_rank,intracomm,ierr)
+    CALL MPI_COMM_SIZE(intracomm,mpi_size,ierr)
+    CALL MPI_COMM_RANK(intracomm,mpi_rank,ierr)
+    
+    group_color=mpi_rank
+    PRINT *,'group_color',group_color
+
+    CALL MPI_COMM_SPLIT(Comm_client_server,group_color,global_rank,iocomm,ierr)    
+    
+    CALL MPI_COMM_SIZE(iocomm,iosize,ierr)
+    CALL MPI_COMM_RANK(iocomm,iorank,ierr)
+
+    PRINT *,"io_size-> ",iosize,"iorank-> ",iorank
+    
+    ALLOCATE(proc_color(0:iosize-1))
+    CALL MPI_ALLGATHER(color_server,1,MPI_INTEGER,proc_color,1,MPI_INTEGER,iocomm,ierr)
+    print *,"proc_color -> ",proc_color
+    
+    ALLOCATE(client_rank(iosize-1))
+    nb_client=0
+    DO i=0,iosize-1
+      IF (proc_color(i)==color_client) THEN
+        nb_client=nb_client+1
+        client_rank(nb_client)=i
+      ENDIF
+    ENDDO
+
+    PRINT *,"Proces No",mpi_rank,"--> client ",client_rank
+  END SUBROUTINE Init_parallel
+  
+  SUBROUTINE Finalize_parallel
+  USE mod_ioserver_namelist
+#ifdef USE_OASIS
+  USE mod_prism_proto
+#endif
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    
+    IF (using_oasis) THEN
+#ifdef USE_OASIS
+      CALL prism_terminate_proto(ierr)
+#endif
+    ELSE
+      CALL MPI_FINALIZE(ierr)
+    ENDIF
+    
+  END SUBROUTINE Finalize_parallel
+
+END MODULE mod_ioserver_para
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_client.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_client.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_client.f90	(revision 2354)
@@ -0,0 +1,202 @@
+MODULE mod_mpi_buffer_client
+  USE mod_mpi_buffer_parameters
+  USE mpi, ONLY : status_size=>MPI_STATUS_SIZE
+  
+  INTEGER(KIND=8),POINTER :: MPI_Buffer(:)
+  
+  TYPE mpi_requests
+    INTEGER :: request
+    INTEGER :: status(status_size)
+    INTEGER :: Pos
+  END TYPE mpi_requests
+  
+  TYPE(mpi_requests),DIMENSION(max_request) :: pending_request
+  
+  INTEGER :: Buffer_pos
+  INTEGER :: request_pos
+  INTEGER :: buffer_begin
+  INTEGER :: request_begin
+  INTEGER :: nb_request_pending
+  INTEGER,SAVE :: start_pos
+  LOGICAL,SAVE :: ok_new_request
+  LOGICAL,SAVE :: is_last_request
+
+  INTEGER,SAVE      :: mpi_buffer_size
+  INTEGER,SAVE      :: aggregated_request
+
+CONTAINS
+
+  SUBROUTINE Init_mpi_buffer
+  USE mod_global_memory
+  USE mod_pack
+  USE mod_ioclient_para
+  IMPLICIT NONE
+
+  INTEGER  :: nb_client
+  
+    nb_client=iosize-1  
+    mpi_buffer_size=global_mpi_buffer_size/nb_client
+    
+    CALL allocate_global_memory(mpi_buffer_size,MPI_Buffer)
+    buffer_begin=1
+    request_begin=1
+    Buffer_pos=1
+    nb_request_pending=0
+    Request_pos=1
+    ok_new_request=.TRUE.
+    is_last_request=.FALSE.
+    aggregated_request=0
+    
+    CALL set_pack_buffer(MPI_Buffer,buffer_begin)
+    
+  END SUBROUTINE Init_mpi_buffer
+  
+
+  SUBROUTINE create_request(request_id)
+  USE mod_pack
+  USE mod_ioclient_para
+  USE mpitrace
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: request_id
+    
+    CALL VTb(VTprocess_event)
+    IF (ok_new_request) THEN  
+      Pending_request(Request_pos)%Pos = pack_pos
+      ok_new_request=.FALSE.
+    ENDIF
+    start_pos=pack_pos
+    pack_pos=pack_pos+1
+!    PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
+    CALL pack_data(request_id)
+  END SUBROUTINE create_request
+  
+  
+  SUBROUTINE Finalize_request
+  USE mod_pack
+  USE mod_ioclient_para
+  USE mpitrace
+  use mod_wait
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: ierr
+    INTEGER :: message_size
+    INTEGER(KIND=8) :: request_size
+    INTEGER :: buffer_free
+    LOGICAL :: ok_out
+    LOGICAL :: is_Buffer_full
+    request_size=pack_pos-start_pos    
+    pack_buffer(start_pos)=request_size
+    message_size=pack_pos-Pending_request(Request_pos)%Pos
+    aggregated_request=aggregated_request+1
+
+
+!! ICI verifier que le buffer ne se recouvre pas ainsi que les requetes
+    
+    ok_out=.FALSE.
+    is_buffer_full=.FALSE.
+    DO WHILE (.NOT. ok_out)
+      CALL check_request
+    
+      IF ( buffer_begin <= pack_pos) THEN
+        Buffer_free=mpi_buffer_size-pack_pos+1
+      ELSE
+        Buffer_free=buffer_begin-pack_pos
+      ENDIF
+      
+!      Print *,"message_size",message_size,"buffer_free",buffer_free
+!      PRINT *,"Request_pos",request_pos
+!      PRINT *,"Pos in Buffer",Pending_request(Request_pos)%Pos,"pack_pos",pack_pos
+      IF ( nb_request_pending==1 .AND. ( (buffer_free < MPI_buffer_size * 0.4) .OR. is_last_request .OR.  &
+                                         (aggregated_request>=max_request/2) )) THEN
+        ok_out=.FALSE.
+        CALL Wait_us(10)
+        IF (.NOT. is_buffer_full) THEN
+          CALL VTb(VTbuffer_full)
+        ENDIF      
+        is_Buffer_full=.TRUE.
+        
+      ELSE
+        ok_out=.TRUE.
+        IF (is_buffer_full) THEN
+          CALL VTe(VTbuffer_full)
+        ENDIF
+        is_buffer_full=.FALSE.
+      
+      ENDIF
+      
+   ENDDO
+   
+   IF (nb_request_pending==0 .OR. (buffer_free < MPI_buffer_size* 0.4 ) .OR. (aggregated_request> max_request/2) ) THEN
+      
+     CALL MPI_ISSEND(MPI_Buffer(Pending_request(Request_pos)%Pos),message_size,MPI_INTEGER8,     &
+                    server_rank,tag_iocomm,iocomm,Pending_request(Request_pos)%request,ierr )
+    
+!    PRINT *,"Requete envoyï¿œe !!!!" 
+!    PRINT *,"Message : ",MPI_Buffer(Pending_request(Request_pos)%Pos:Pending_request(Request_pos)%Pos+message_size-1)              
+      IF ( Pack_Pos > MPI_buffer_size*0.6 ) THEN
+        Pack_Pos=1
+      ENDIF
+    
+      IF (Request_Pos==max_request) THEN
+        Request_Pos=1
+      ELSE 
+        Request_Pos=Request_Pos+1
+      ENDIF
+      nb_request_pending=nb_request_pending+1
+    
+      ok_new_request=.TRUE.
+      aggregated_request=0
+    ENDIF
+    CALL VTe(VTprocess_event)    
+  END SUBROUTINE Finalize_request
+
+
+  SUBROUTINE Check_request
+  USE mpi_mod
+  IMPLICIT NONE
+  LOGICAL :: ok_out
+  LOGICAL :: OK_complete
+  INTEGER :: ierr
+  
+!    PRINT *, 'on entre dans Check_request'
+!    PRINT *, 'nb_request_pending',nb_request_pending
+    
+    IF (nb_request_pending>0) THEN
+      ok_out=.FALSE.
+    ELSE
+      ok_out=.TRUE.
+    ENDIF
+    
+    DO WHILE (.NOT. ok_out)
+    
+!      PRINT *,'Testing_request...'
+!      PRINT *,'request_begin',request_begin
+      CALL MPI_TEST(Pending_request(request_begin)%request,ok_complete,Pending_request(request_begin)%status,ierr)
+!      PRINT *,'Request has been tested...'
+      IF (ok_complete) THEN
+!        PRINT *,"Request_completed"
+        IF (Request_begin==max_request) THEN
+          Request_begin=1
+        ELSE
+          request_begin=request_begin+1
+        ENDIF
+        
+        buffer_begin=Pending_request(request_begin)%Pos
+        
+        nb_request_pending=nb_request_pending-1
+        
+        IF (nb_request_pending==0) THEN 
+          ok_out=.TRUE.
+        ELSE
+          ok_out=.FALSE.
+        ENDIF
+      ELSE
+        ok_out=.TRUE.
+      ENDIF
+    
+    ENDDO
+!    PRINT *, 'on sort de Check_request'  
+  END SUBROUTINE Check_Request
+
+END MODULE mod_mpi_buffer_client
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_parameters.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_parameters.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_parameters.f90	(revision 2354)
@@ -0,0 +1,7 @@
+MODULE mod_mpi_buffer_parameters
+  USE mod_ioserver_namelist, ONLY : global_mpi_buffer_size
+  INTEGER,PARAMETER :: max_request = 10000
+  REAL, PARAMETER   :: frac_alert  = 0.9
+  INTEGER           :: tag_iocomm  = 4000
+  INTEGER           :: tag_terminate = 4001
+END MODULE mod_mpi_buffer_parameters
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_server.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_server.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_mpi_buffer_server.f90	(revision 2354)
@@ -0,0 +1,262 @@
+MODULE mod_mpi_buffer_server
+  USE mod_mpi_buffer_parameters
+
+  TYPE mpi_requests
+    INTEGER :: Pos
+    INTEGER :: size
+  END TYPE mpi_requests
+  
+  TYPE buffer
+    INTEGER(KIND=8),POINTER  :: mpi_buffer(:)
+    INTEGER :: pos
+    INTEGER :: begin
+    TYPE(mpi_requests),POINTER :: request(:)
+    INTEGER :: request_pos
+    INTEGER :: nb_request
+    INTEGER :: request_begin
+    INTEGER :: request_free
+    LOGICAL :: is_posted
+    LOGICAL :: is_terminated
+    INTEGER :: last_request
+  END TYPE buffer
+
+  TYPE(buffer),ALLOCATABLE,SAVE :: buffers(:)
+  
+  INTEGER,SAVE :: current_rank
+  INTEGER,SAVE :: mpi_buffer_size
+  
+CONTAINS
+  
+  SUBROUTINE Init_mpi_buffer
+  USE mod_ioserver_para
+  USE mod_global_memory
+  IMPLICIT NONE
+    INTEGER :: n
+    
+    ALLOCATE(buffers(nb_client))
+    mpi_buffer_size=global_mpi_buffer_size/nb_client 
+    DO n=1,nb_client
+      CALL allocate_global_memory(mpi_buffer_size,buffers(n)%MPI_Buffer)
+      buffers(n)%pos=1
+      buffers(n)%begin=1
+      ALLOCATE(buffers(n)%request(max_request))
+      buffers(n)%nb_request=0
+      buffers(n)%request_free=max_request
+      buffers(n)%request_pos=1
+      buffers(n)%request_begin=1
+      buffers(n)%is_posted=.FALSE.
+      buffers(n)%is_terminated=.FALSE.
+    ENDDO
+
+  END SUBROUTINE Init_mpi_buffer
+
+  SUBROUTINE Check_buffer
+  USE mod_ioserver_para
+  USE mpitrace
+  USE mpi_mod
+  IMPLICIT NONE
+    INTEGER :: n
+    INTEGER :: status(MPI_STATUS_SIZE)
+    LOGICAL :: ok_complete
+    LOGICAL :: ok_out
+    INTEGER :: ierr
+    INTEGER :: message_size
+    INTEGER :: Buffer_space 
+    INTEGER :: request
+    
+    CALL VTb(VTcheck_buffer)
+    DO n=1,nb_client
+      ok_out=.FALSE.
+      
+      DO WHILE (.NOT. ok_out)
+        
+        IF (buffers(n)%is_posted) THEN
+!          PRINT*,"MPI_TEST"
+!          PRINT *,"MPI_TEST LAST_REQUEST (avant)",buffers(n)%last_request,"ok_complete ?",ok_complete
+          CALL MPI_TEST(buffers(n)%last_request,ok_complete,status,ierr)
+!          PRINT *,"MPI_TEST LAST_REQUEST (apres)",buffers(n)%last_request,"ok_complete ?",ok_complete
+
+          IF (ok_complete) THEN
+            CALL MPI_GET_COUNT(status,MPI_INTEGER8,message_size,ierr)
+            CALL Fill_request(n,Buffers(n)%pos,message_size)
+            buffers(n)%is_posted=.FALSE.
+            buffers(n)%pos=buffers(n)%pos+message_size
+         
+!            PRINT *,"buffer_pos",buffers(n)%pos
+!            PRINT *,"Message recu de taille", message_size
+!              PRINT *,"Message : ",buffers(n)%mpi_buffer(buffers(n)%pos:buffers(n)%pos+message_size-1)
+!              PRINT *,"Nouvelle taille buffer_pos",buffers(n)%pos
+              ok_out=.FALSE.
+          ELSE
+              ok_out=.TRUE.
+          ENDIF
+       
+        ELSE  ! (.NOT. is_posted)        
+!          PRINT *,"MPI_IPROBE"
+     
+          CALL MPI_IPROBE(client_rank(n),tag_iocomm,iocomm,ok_complete,status,ierr)
+!          PRINT *,"Ok_complete.. ?",ok_complete
+          IF (ok_complete) THEN
+            CALL MPI_GET_COUNT(status,MPI_INTEGER8,message_size,ierr)
+!            PRINT *,"message_size",message_size
+            IF (buffers(n)%pos >= buffers(n)%begin) THEN
+              IF (buffers(n)%pos+message_size>mpi_buffer_size) THEN
+                buffer_space=buffers(n)%begin-1
+              ELSE
+                buffer_space=mpi_buffer_size-buffers(n)%begin+1
+              ENDIF
+            ELSE
+              buffer_space=buffers(n)%begin-buffers(n)%pos
+            ENDIF
+            
+            IF (buffer_space < message_size .OR. buffers(n)%request_free<=max_request/2) THEN
+              ok_out=.TRUE.
+!              PRINT *,"BUFFER FULL !!!!"
+!              PRINT *,"buffer_space",buffer_space,"request_free",buffers(n)%request_free
+!              PRINT *,"buffer_pos",buffers(n)%pos,"buffer_begin",buffers(n)%begin
+            ELSE
+              
+              IF (buffers(n)%pos+message_size>mpi_buffer_size) buffers(n)%pos=1
+          
+!              PRINT *,'reception du message'
+              CALL MPI_IRECV(buffers(n)%mpi_buffer(buffers(n)%pos),message_size,MPI_INTEGER8,          &
+                          client_rank(n),tag_iocomm,iocomm,buffers(n)%last_request,ierr)
+                          
+              buffers(n)%is_posted=.TRUE.
+!              PRINT *,"MPI_IRECV LAST_REQUEST",buffers(n)%last_request
+              CALL MPI_TEST(buffers(n)%last_request,ok_complete,status,ierr)
+!              PRINT *,"MPI_TEST LAST_REQUEST",buffers(n)%last_request,"ok_complete ?",ok_complete
+              
+              IF (ok_complete) THEN
+                buffers(n)%is_posted=.FALSE.
+                CALL Fill_request(n,Buffers(n)%pos,message_size)
+
+                buffers(n)%pos=buffers(n)%pos+message_size
+                 
+!                PRINT *,"buffer_pos",buffers(n)%pos
+!                PRINT *,"Message recu de taille", message_size
+!                PRINT *,"Message : ",buffers(n)%mpi_buffer(buffers(n)%pos:buffers(n)%pos+message_size-1)
+!                PRINT *,"Nouvelle taille buffer_pos",buffers(n)%pos
+                ok_out=.FALSE.
+              ELSE
+                ok_out=.TRUE.
+              ENDIF
+         
+            ENDIF
+          ELSE
+            ok_out=.TRUE.
+          ENDIF
+        ENDIF  ! (is_posted)
+        ok_out=.TRUE.
+      ENDDO
+    ENDDO
+
+    CALL VTe(VTcheck_buffer)
+
+  END SUBROUTINE Check_buffer
+  
+  SUBROUTINE Fill_request(n,pos,message_size)
+  USE mpi
+  IMPLICIT NONE
+    INTEGER :: n
+    INTEGER :: pos
+    INTEGER :: message_size
+    INTEGER :: current_size
+    INTEGER :: current_pos
+    INTEGER :: total_size
+    LOGICAL :: ok_out
+    INTEGER :: ierr
+!    PRINT *,'Fill_request!!!'
+!    PRINT *,'Buffer_pos',pos
+!    PRINT *,"First integer",Buffers(n)%mpi_buffer(pos)
+    total_size=0
+    current_pos=pos
+    
+    ok_out=.FALSE.
+    DO WHILE (.NOT. ok_out)
+      
+      IF (Buffers(n)%request_free==0) THEN
+        PRINT *,'Plus de requete disponible !!!!'
+        CALL MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
+      ENDIF
+      
+      current_size=buffers(n)%mpi_buffer(current_pos)
+      Buffers(n)%request(Buffers(n)%request_pos)%pos=current_pos+1
+      Buffers(n)%request(Buffers(n)%request_pos)%size=current_size
+      total_size=total_size+current_size
+      
+      IF (Buffers(n)%request_pos==max_request) THEN 
+        Buffers(n)%request_pos=1
+      ELSE
+        Buffers(n)%request_pos=Buffers(n)%request_pos+1
+      ENDIF
+      Buffers(n)%request_free=Buffers(n)%request_free-1
+      Buffers(n)%nb_request=Buffers(n)%nb_request+1
+      
+      IF (total_size==message_size) ok_out=.TRUE.
+      IF (total_size>message_size) THEN
+        PRINT *,"Probleme : la taille du message ne coincide pas avec la taille de l'enveloppe"
+        CALL MPI_ABORT(MPI_COMM_WORLD,-1,ierr)
+      ENDIF
+      
+      current_pos=current_pos+current_size
+    ENDDO
+  
+  END SUBROUTINE Fill_request 
+    
+  
+  SUBROUTINE Process_request(is_terminated)
+  USE mod_event_server
+  USE mod_ioserver_para
+  USE mod_pack
+  USE mpitrace
+  USE mod_wait
+  IMPLICIT NONE
+    LOGICAL  :: is_terminated
+    INTEGER  :: n
+    
+    is_terminated=.FALSE.
+    
+    IF (ALL(buffers(:)%nb_request>0)) THEN
+      DO n=1,nb_client
+!        PRINT *,"nb_request ?",buffers(n)%nb_request
+        IF ( (buffers(n)%nb_request > 0) .AND. (.NOT. buffers(n)%is_terminated)) THEN
+!          PRINT *,"request_pos",buffers(n)%request_begin
+!          PRINT *,"buffer_pos",buffers(n)%request(buffers(n)%request_begin)%pos
+          CALL set_pack_buffer(buffers(n)%mpi_buffer,buffers(n)%request(buffers(n)%request_begin)%pos)
+          CALL VTb(VTprocess_event)
+          current_rank=n
+          CALL process_event(n,buffers(n)%is_terminated)
+          CALL VTe(VTprocess_event)
+          buffers(n)%nb_request=buffers(n)%nb_request-1
+          buffers(n)%request_free=buffers(n)%request_free+1
+        
+       
+          IF (Buffers(n)%request_begin==max_request) THEN
+            Buffers(n)%request_begin=1
+          ELSE
+            buffers(n)%request_begin=Buffers(n)%request_begin+1
+          ENDIF
+          
+          IF (buffers(n)%nb_request > 0) THEN 
+            buffers(n)%begin=buffers(n)%request(buffers(n)%request_begin)%pos
+          ELSE
+            buffers(n)%begin=buffers(n)%pos
+          ENDIF
+        ENDIF
+      ENDDO 
+    
+!      PRINT *,"buffers_is_terminated",buffers(1:nb_client)%is_terminated
+!      PRINT *,"buffers_nb_request",buffers(1:nb_client)%nb_request
+      IF (ALL(buffers(1:nb_client)%is_terminated)) THEN
+        IF (ALL(buffers(1:nb_client)%nb_request==0)) THEN
+          is_terminated=.TRUE.
+        ENDIF
+      ENDIF
+    ELSE
+      CALL Wait_us(5)
+    ENDIF     
+  END SUBROUTINE process_request  
+  
+    
+END MODULE mod_mpi_buffer_server
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_pack.f90	(revision 2354)
@@ -0,0 +1,603 @@
+  MODULE mod_pack
+    INTEGER,PARAMETER :: integer_size=4
+    INTEGER,PARAMETER :: pack_buffer_max_size=integer_size*1024*1024
+    INTEGER(kind=8),POINTER,SAVE      :: pack_buffer(:)
+    INTEGER,SAVE      :: pack_pos
+    
+    INTERFACE pack_data
+      MODULE PROCEDURE pack_r,pack_r1,pack_r2,pack_r3,pack_r4,                 &
+                       pack_i,pack_i1,pack_i2,pack_i3,pack_i4,                 &
+                       pack_l,pack_l1,pack_l2,pack_l3,pack_l4,                 &
+                       pack_c,pack_c1,pack_c2,pack_c3,pack_c4,                 &
+                       pack_attr
+    END INTERFACE pack_data
+
+    INTERFACE unpack_data
+      MODULE PROCEDURE unpack_r,unpack_r1,unpack_r2,unpack_r3,unpack_r4,       &
+                       unpack_i,unpack_i1,unpack_i2,unpack_i3,unpack_i4,       &
+                       unpack_l,unpack_l1,unpack_l2,unpack_l3,unpack_l4,       &
+                       unpack_c,unpack_c1,unpack_c2,unpack_c3,unpack_c4,       &
+                       unpack_attr
+    END INTERFACE unpack_data
+
+    INTERFACE pack_field
+      MODULE PROCEDURE pack_field1,pack_field2,pack_field3,pack_field4        
+    END INTERFACE pack_field
+
+    INTERFACE unpack_field
+      MODULE PROCEDURE unpack_field1,unpack_field2,unpack_field3,unpack_field4 
+    END INTERFACE unpack_field
+           
+  CONTAINS
+  
+    SUBROUTINE set_pack_buffer(pack_buffer0,pack_pos0)
+    IMPLICIT NONE
+    INTEGER(kind=8),POINTER  :: pack_buffer0(:)
+    INTEGER                  :: pack_pos0
+    
+      pack_buffer=>pack_buffer0
+      pack_pos=pack_pos0
+
+    END SUBROUTINE set_pack_buffer
+    
+    
+    SUBROUTINE pack_r(arg)
+      IMPLICIT NONE
+        REAL :: arg
+         
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_r
+     
+     SUBROUTINE pack_r1(arg)
+      IMPLICIT NONE
+        REAL :: arg(:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r1
+
+    
+     SUBROUTINE pack_r2(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r2
+     
+     
+     SUBROUTINE pack_r3(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r3
+
+     
+     SUBROUTINE pack_r4(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:,:)
+        
+        CALL packf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_r4
+
+
+    SUBROUTINE unpack_r(arg)
+      IMPLICIT NONE
+        REAL :: arg
+         
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_r
+     
+     SUBROUTINE unpack_r1(arg)
+      IMPLICIT NONE
+        REAL :: arg(:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r1
+
+    
+     SUBROUTINE unpack_r2(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r2
+     
+     
+     SUBROUTINE unpack_r3(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r3
+
+     
+     SUBROUTINE unpack_r4(arg)
+      IMPLICIT NONE
+        REAL :: arg(:,:,:,:)
+        
+        CALL unpackf_r(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_r4
+
+
+
+
+    SUBROUTINE pack_i(arg)
+      IMPLICIT NONE
+        INTEGER :: arg
+         
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_i
+     
+     SUBROUTINE pack_i1(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i1
+
+    
+     SUBROUTINE pack_i2(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i2
+     
+     
+     SUBROUTINE pack_i3(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i3
+
+     
+     SUBROUTINE pack_i4(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:,:)
+        
+        CALL packf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_i4
+     
+
+    SUBROUTINE unpack_i(arg)
+      IMPLICIT NONE
+        INTEGER :: arg
+         
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_i
+     
+     SUBROUTINE unpack_i1(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i1
+
+    
+     SUBROUTINE unpack_i2(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i2
+     
+     
+     SUBROUTINE unpack_i3(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i3
+
+     
+     SUBROUTINE unpack_i4(arg)
+      IMPLICIT NONE
+        INTEGER :: arg(:,:,:,:)
+        
+        CALL unpackf_i(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_i4     
+
+
+
+
+
+
+
+    SUBROUTINE pack_l(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg
+         
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE pack_l
+     
+     SUBROUTINE pack_l1(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l1
+
+    
+     SUBROUTINE pack_l2(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l2
+     
+     
+     SUBROUTINE pack_l3(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l3
+
+     
+     SUBROUTINE pack_l4(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:,:)
+        
+        CALL packf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE pack_l4
+     
+
+    SUBROUTINE unpack_l(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg
+         
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,1)
+     
+     END SUBROUTINE unpack_l
+     
+     SUBROUTINE unpack_l1(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l1
+
+    
+     SUBROUTINE unpack_l2(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l2
+     
+     
+     SUBROUTINE unpack_l3(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l3
+
+     
+     SUBROUTINE unpack_l4(arg)
+      IMPLICIT NONE
+        LOGICAL :: arg(:,:,:,:)
+        
+        CALL unpackf_l(pack_buffer(pack_pos),pack_pos,arg,size(arg))
+        
+     END SUBROUTINE unpack_l4     
+
+
+
+
+   
+     
+   SUBROUTINE pack_c(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg
+         
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
+     
+     END SUBROUTINE pack_c
+     
+     SUBROUTINE pack_c1(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
+        
+     END SUBROUTINE pack_c1
+
+    
+     SUBROUTINE pack_c2(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
+        
+     END SUBROUTINE pack_c2
+     
+     
+     SUBROUTINE pack_c3(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
+        
+     END SUBROUTINE pack_c3
+
+     
+     SUBROUTINE pack_c4(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:,:)
+        
+        CALL packf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
+        
+     END SUBROUTINE pack_c4
+     
+
+    SUBROUTINE unpack_c(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg
+         
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,len(arg))
+     
+     END SUBROUTINE unpack_c
+     
+     SUBROUTINE unpack_c1(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1)))
+        
+     END SUBROUTINE unpack_c1
+
+    
+     SUBROUTINE unpack_c2(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1)))
+        
+     END SUBROUTINE unpack_c2
+     
+     
+     SUBROUTINE unpack_c3(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1)))
+        
+     END SUBROUTINE unpack_c3
+
+     
+     SUBROUTINE unpack_c4(arg)
+      IMPLICIT NONE
+        CHARACTER(len=*) :: arg(:,:,:,:)
+        
+        CALL unpackf_c(pack_buffer(pack_pos),pack_pos,arg,size(arg)*len(arg(1,1,1,1)))
+        
+     END SUBROUTINE unpack_c4     
+     
+
+
+
+
+     SUBROUTINE pack_field1(arg)
+     IMPLICIT NONE
+       REAL :: arg(:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field1
+
+
+     SUBROUTINE pack_field2(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:)
+       
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field2
+     
+     SUBROUTINE pack_field3(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field3
+
+     SUBROUTINE pack_field4(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:,:)
+     
+       CALL packf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE pack_field4
+
+
+
+     SUBROUTINE unpack_field1(arg)
+     IMPLICIT NONE
+       REAL :: arg(:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field1
+
+
+     SUBROUTINE unpack_field2(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field2
+     
+     SUBROUTINE unpack_field3(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field3
+
+     SUBROUTINE unpack_field4(arg)
+     IMPLICIT NONE
+       REAL :: arg(:,:,:,:)
+     
+       CALL unpackf_field(pack_buffer(pack_pos),pack_pos,arg,size(arg)) 
+     END SUBROUTINE unpack_field4
+      
+     SUBROUTINE pack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL pack_data(attrib%object)
+       CALL pack_data(attrib%name)
+       CALL pack_data(attrib%type)
+       CALL pack_data(attrib%dim)
+       CALL pack_data(attrib%ndim)
+       CALL pack_data(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           CALL pack_data(attrib%integer0_ptr)
+         CASE (integer1)
+           CALL pack_data(attrib%integer1_ptr)
+         CASE (integer2)
+           CALL pack_data(attrib%integer2_ptr)
+         CASE (real0)
+           CALL pack_data(attrib%real0_ptr)
+         CASE (real1)
+           CALL pack_data(attrib%real1_ptr)
+         CASE (real2)
+           CALL pack_data(attrib%real2_ptr)
+         CASE (logical0)
+           CALL pack_data(attrib%logical0_ptr)
+         CASE (logical1)
+           CALL pack_data(attrib%logical1_ptr)
+         CASE (logical2)
+           CALL pack_data(attrib%logical2_ptr)
+         CASE (string0)
+           CALL pack_string0(attrib%string0_ptr)
+         CASE (string1)
+           CALL pack_string1(attrib%string1_ptr)
+         CASE (string2)
+           CALL pack_data(attrib%string2_ptr)
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE pack_string0(str)
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL pack_data(str)
+       END SUBROUTINE
+
+       SUBROUTINE pack_string1(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:)
+           CALL pack_data(str)
+       END SUBROUTINE
+       
+       SUBROUTINE pack_string2(str)
+         CHARACTER(LEN=attrib%string_len) ::str(:,:)
+           CALL pack_data(str)
+       END SUBROUTINE
+
+     END SUBROUTINE pack_attr  
+
+     SUBROUTINE unpack_attr(attrib)
+     USE mod_attribut
+     USE mod_stdtype
+     IMPLICIT NONE
+       TYPE(attribut) :: attrib
+
+       CALL unpack_data(attrib%object)
+       CALL unpack_data(attrib%name)
+       CALL unpack_data(attrib%type)
+       CALL unpack_data(attrib%dim)
+       CALL unpack_data(attrib%ndim)
+       CALL unpack_data(attrib%string_len)
+              
+       SELECT CASE(attrib%type)
+         CASE (integer0)
+           ALLOCATE(attrib%integer0_ptr)
+           CALL unpack_data(attrib%integer0_ptr)
+         CASE (integer1)
+           ALLOCATE(attrib%integer1_ptr(attrib%dim(1)))
+           CALL unpack_data(attrib%integer1_ptr)
+         CASE (integer2)
+           ALLOCATE(attrib%integer2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_data(attrib%integer2_ptr)
+         CASE (real0)
+           ALLOCATE(attrib%real0_ptr)
+           CALL unpack_data(attrib%real0_ptr)
+         CASE (real1)
+           ALLOCATE(attrib%real1_ptr(attrib%dim(1)))
+           CALL unpack_data(attrib%real1_ptr)
+         CASE (real2)
+           ALLOCATE(attrib%real2_ptr(attrib%dim(1),attrib%dim(2)))
+         CASE (logical0)
+           ALLOCATE(attrib%logical0_ptr)
+           CALL unpack_data(attrib%logical0_ptr)
+         CASE (logical1)
+           ALLOCATE(attrib%logical1_ptr(attrib%dim(1)))
+           CALL unpack_data(attrib%logical1_ptr)
+         CASE (logical2)
+           ALLOCATE(attrib%logical2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_data(attrib%logical2_ptr)
+         CASE (string0)
+           ALLOCATE(attrib%string0_ptr)
+           CALL unpack_string0
+         CASE (string1)
+           ALLOCATE(attrib%string1_ptr(attrib%dim(1)))
+           CALL unpack_string1
+         CASE (string2)
+           ALLOCATE(attrib%string2_ptr(attrib%dim(1),attrib%dim(2)))
+           CALL unpack_string2
+       END SELECT
+
+     CONTAINS
+
+       SUBROUTINE unpack_string0
+         CHARACTER(LEN=attrib%string_len) ::str
+           CALL unpack_data(str)
+           attrib%string0_ptr=str
+       END SUBROUTINE
+
+       SUBROUTINE unpack_string1
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1))
+           CALL unpack_data(str)
+           attrib%string1_ptr=str
+       END SUBROUTINE
+       
+       SUBROUTINE unpack_string2
+         CHARACTER(LEN=attrib%string_len) ::str(attrib%dim(1),attrib%dim(2))
+           CALL unpack_data(str)
+           attrib%string2_ptr=str
+       END SUBROUTINE
+
+     END SUBROUTINE unpack_attr              
+
+     
+  END MODULE mod_pack
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_prec.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_prec.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_prec.f90	(revision 2354)
@@ -0,0 +1,7 @@
+MODULE mod_prec
+  INTEGER,PARAMETER :: INTEGER_SIZE   = 4 
+  INTEGER,PARAMETER :: REAL_SIZE      = 8 
+  INTEGER,PARAMETER :: LOGICAL_SIZE   = 4 
+  INTEGER,PARAMETER :: CHARACTER_SIZE = 1
+  INTEGER,PARAMETER :: BLOCK_SIZE     = 8
+END MODULE mod_prec
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_wait.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_wait.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mod_wait.f90	(revision 2354)
@@ -0,0 +1,68 @@
+MODULE mod_wait
+  INTEGER, SAVE :: wait_param=10
+  REAL, SAVE    :: opt_param
+
+
+  INTEGER, SAVE :: last_count
+
+CONTAINS
+
+  
+  FUNCTION Top()
+  IMPLICIT NONE
+    DOUBLE PRECISION :: Top
+    INTEGER :: count,count_rate,count_max
+    LOGICAL, SAVE :: first=.TRUE.
+    
+      
+    CALL system_clock(count,count_rate,count_max)
+    IF (first) THEN
+      Top=0.
+    ELSE
+      IF (Count>=Last_Count) THEN
+        Top=(1.*(Count-last_Count))/count_rate
+      ELSE
+        Top=(1.*(Count-last_Count+Count_max))/count_rate
+      ENDIF
+    ENDIF
+    Last_Count=Count
+    first=.FALSE. 
+  END FUNCTION Top
+  
+  SUBROUTINE Init_wait
+  IMPLICIT NONE
+    INTEGER :: i,j
+    LOGICAL :: out_ok
+    DOUBLE PRECISION :: time 
+    INTEGER :: last_param
+  
+    out_ok=.FALSE.
+    
+    DO WHILE (.NOT. out_ok)
+      opt_param=0.
+    
+      time=top()
+!CDIR NOVECTOR
+      DO i=1,1000000*wait_param
+         opt_param=opt_param+(i/(i+opt_param))
+      ENDDO
+      time=top()
+      last_param=wait_param
+      wait_param=wait_param*(1./time)
+      IF (ABS(wait_param-last_param)/(0.5*(wait_param+last_param)) <0.01) out_ok=.TRUE.
+    END DO
+  END SUBROUTINE Init_wait
+
+  SUBROUTINE Wait_us(n)
+  IMPLICIT NONE
+  INTEGER :: n
+  INTEGER :: i
+
+!CDIR NOVECTOR  
+    DO i=1,n*wait_param
+         opt_param=opt_param+(i/(i+opt_param))
+    ENDDO
+      
+  END SUBROUTINE Wait_us   
+
+END MODULE mod_wait  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpi_mod.F90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpi_mod.F90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpi_mod.F90	(revision 2354)
@@ -0,0 +1,11 @@
+MODULE mpi_mod
+
+#ifdef NO_MPI
+    LOGICAL, PARAMETER :: using_mpi=.FALSE.
+    INCLUDE 'ios_mpif.h'
+#else
+    LOGICAL, PARAMETER :: using_mpi=.TRUE.
+    INCLUDE 'mpif.h'
+#endif
+
+END MODULE mpi_mod
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpi_wrapper.F90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpi_wrapper.F90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpi_wrapper.F90	(revision 2354)
@@ -0,0 +1,80 @@
+SUBROUTINE void
+
+END SUBROUTINE void
+
+#ifdef NO_MPI
+
+SUBROUTINE MPI_ALLOC_MEM
+
+END SUBROUTINE MPI_ALLOC_MEM
+
+
+SUBROUTINE MPI_INITIALIZED
+
+END SUBROUTINE MPI_INITIALIZED
+
+
+SUBROUTINE MPI_INIT
+
+END SUBROUTINE MPI_INIT
+
+
+SUBROUTINE MPI_COMM_SIZE
+
+END SUBROUTINE MPI_COMM_SIZE
+
+
+SUBROUTINE MPI_COMM_RANK
+
+END SUBROUTINE MPI_COMM_RANK 
+
+
+SUBROUTINE MPI_COMM_SPLIT
+
+END SUBROUTINE MPI_COMM_SPLIT
+
+
+SUBROUTINE MPI_ALLGATHER
+
+END SUBROUTINE MPI_ALLGATHER
+
+
+SUBROUTINE MPI_FINALIZE
+
+END SUBROUTINE MPI_FINALIZE
+
+
+SUBROUTINE MPI_ISSEND
+
+END SUBROUTINE MPI_ISSEND
+
+
+SUBROUTINE MPI_TEST
+
+END SUBROUTINE MPI_TEST
+
+
+SUBROUTINE MPI_GET_COUNT
+
+END SUBROUTINE MPI_GET_COUNT
+
+
+SUBROUTINE MPI_IPROBE 
+
+END SUBROUTINE MPI_IPROBE 
+
+
+SUBROUTINE MPI_IRECV
+
+END SUBROUTINE MPI_IRECV
+
+
+SUBROUTINE MPI_ABORT
+
+END SUBROUTINE MPI_ABORT
+
+SUBROUTINE MPI_BARRIER
+
+END SUBROUTINE MPI_BARRIER
+
+#endif
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpitrace.F90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpitrace.F90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/mpitrace.F90	(revision 2354)
@@ -0,0 +1,78 @@
+module mpitrace
+  INTEGER,parameter :: VTcheck_buffer=91
+  INTEGER,parameter :: VTprocess_event=92
+  INTEGER,parameter :: VTbuffer_full=93
+  
+  INTEGER,parameter :: nb_inst=7
+  INTEGER :: MPE_begin(nb_inst)
+  INTEGER :: MPE_end(nb_inst)
+  
+contains
+
+  subroutine InitVampir
+    implicit none
+
+#ifdef USE_VT
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTSYMDEF(VTcheck_buffer,"check_buffer","check_buffer",ierr)
+    call VTSYMDEF(VTprocess_event,"process_event","process_event",ierr)
+    call VTSYMDEF(VTbuffer_full,"buffer_full","buffer_full",ierr)
+    PRINT *,'definition des symbole VT'
+#endif
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    
+    DO i=1,nb_inst
+      ierr = MPE_Log_get_state_eventIDs( MPE_begin(i), MPE_end(i) )
+    ENDDO
+    
+    ierr = MPE_Describe_state( MPE_begin(VTcaldyn), MPE_end(VTcaldyn),"caldyn", "yellow" )
+    ierr = MPE_Describe_state( MPE_begin(VTintegre), MPE_end(VTintegre),"integre", "blue" )
+    ierr = MPE_Describe_state( MPE_begin(VTadvection), MPE_end(VTadvection),"advection", "green" )
+    ierr = MPE_Describe_state( MPE_begin(VTdissipation), MPE_end(VTdissipation),"dissipation", "ivory" )
+    ierr = MPE_Describe_state( MPE_begin(VThallo), MPE_end(VThallo),"hallo", "orange" )
+    ierr = MPE_Describe_state( MPE_begin(VTphysiq), MPE_end(VTphysiq),"physiq", "purple" )
+    ierr = MPE_Describe_state( MPE_begin(VTinca), MPE_end(VTinca),"inca", "LightBlue" )
+#endif     
+  end subroutine InitVampir
+
+  subroutine VTb(number)
+    implicit none
+    INTEGER :: number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+    
+    call VTBEGIN(number,ierr)
+#endif 
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_begin(number), 0, '' )
+#endif
+
+  end subroutine VTb
+
+  subroutine VTe(number)
+    implicit none
+    INTEGER :: Number
+#ifdef USE_VT    
+    include 'VT.inc'
+    integer :: ierr
+   
+    call VTEND(number,ierr)
+#endif    
+
+#ifdef USE_MPE
+    include 'mpe_logf.h' 
+    integer :: ierr,i
+    ierr = MPE_Log_event( MPE_end(number), 0, '' )
+#endif
+
+  end subroutine VTe
+  
+end module mpitrace
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/pack_c.c.old
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/pack_c.c.old	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/pack_c.c.old	(revision 2354)
@@ -0,0 +1,101 @@
+
+
+
+typedef int     INTEGER ;
+typedef double  REAL    ;
+typedef int     LOGICAL ; 
+typedef char    CHARACTER ;
+
+int INTEGER_SIZE   = 4 ;
+int REAL_SIZE      = 8 ;
+int LOGICAL_SIZE   = 4 ;
+int CHARACTER_SIZE = 1 ;
+
+
+
+
+
+
+
+void packc_r_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*REAL_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+    
+void packc_i_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*INTEGER_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+
+}
+
+void packc_l_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*LOGICAL_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+
+void packc_c_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size, int strsize)
+{
+  int i ;
+   printf("longueur de la chaine %i \n",strsize) ;
+  for(i=0;i<(*size)*CHARACTER_SIZE;i++,(*position)++) buffer[*position]=var[i] ;
+}
+
+
+void unpackc_r_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+
+  for(i=0;i<(*size)*REAL_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+    
+void unpackc_i_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*INTEGER_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+
+}
+
+void unpackc_l_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*LOGICAL_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+
+void unpackc_c_(unsigned char * buffer, INTEGER * position, unsigned char * var, INTEGER * size,int strsize)
+{
+  int i ;
+  
+  for(i=0;i<(*size)*CHARACTER_SIZE;i++,(*position)++) var[i]=buffer[*position] ;
+}
+
+void packc_field_(REAL* buffer, INTEGER* position, REAL* var,INTEGER * size)
+{
+  int i;
+  int s ;
+  
+  s=*size ;
+  buffer+=(*position) ;
+#pragma vdir nooverlap
+  for(i=0;i<s;i++) buffer[i]=var[i] ;
+  position+=s ;
+}
+
+void unpackc_field_(REAL* buffer, INTEGER* position, REAL* var,INTEGER* size)
+{
+  int i;
+  int s ;
+  
+  s=*size ;
+  buffer+=(*position) ;
+#pragma vdir nooverlap
+  for(i=0;i<s;i++) var[i]=buffer[i] ;
+  position+=s ;
+}
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/pack_f.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/pack_f.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/pack_f.f90	(revision 2354)
@@ -0,0 +1,220 @@
+SUBROUTINE packf_r(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+
+    tot_size=var_size*REAL_SIZE
+
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+
+END SUBROUTINE packf_r
+
+
+SUBROUTINE packf_field(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_field
+
+SUBROUTINE packf_i(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    INTEGER,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    INTEGER,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*INTEGER_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_i
+
+SUBROUTINE packf_l(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    LOGICAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    LOGICAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*LOGICAL_SIZE
+        
+    DO i=1,var_size
+      buffer(i)=var(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_l
+
+SUBROUTINE packf_c(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER                  :: var_size
+    CHARACTER(LEN=var_size)  :: buffer
+    INTEGER                  :: position
+    CHARACTER(LEN=var_size)  :: var
+   
+    INTEGER :: tot_size
+    
+    tot_size=var_size*CHARACTER_SIZE
+        
+    buffer(1:var_size)=var(1:var_size)
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE packf_c
+
+
+
+
+
+
+SUBROUTINE unpackf_r(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_r
+
+
+SUBROUTINE unpackf_field(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    REAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    REAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*REAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_field
+
+SUBROUTINE unpackf_i(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    INTEGER,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    INTEGER,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*INTEGER_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_i
+
+SUBROUTINE unpackf_l(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER           :: var_size
+    LOGICAL,DIMENSION(var_size) :: buffer
+    INTEGER           :: position
+    LOGICAL,DIMENSION(var_size) :: var
+   
+    INTEGER :: i
+    INTEGER :: tot_size
+    
+    tot_size=var_size*LOGICAL_SIZE
+        
+    DO i=1,var_size
+      var(i)=buffer(i)
+    ENDDO
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_l
+
+SUBROUTINE unpackf_c(buffer,position,var,var_size)
+  USE mod_prec
+  IMPLICIT NONE
+    INTEGER                  :: var_size
+    CHARACTER(LEN=var_size)  :: buffer
+    INTEGER                  :: position
+    CHARACTER(LEN=var_size)  :: var
+    
+    INTEGER :: tot_size
+    
+    tot_size=var_size*CHARACTER_SIZE
+        
+    var(1:var_size)=buffer(1:var_size)
+          
+    position=position+tot_size/BLOCK_SIZE
+    IF (MOD(tot_size,BLOCK_SIZE)/=0) position=position+1
+    
+END SUBROUTINE unpackf_c
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/server.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/server.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/IOSERVER/server.f90	(revision 2354)
@@ -0,0 +1,46 @@
+PROGRAM server
+  USE mod_ioserver_para
+  USE mod_mpi_buffer_server
+  USE mod_wait
+  USE mod_global_memory
+  USE ioipsl
+  USE iomanager
+  USE mod_interface_ioipsl
+  USE mod_ioserver_namelist
+  
+  IMPLICIT NONE
+  INCLUDE 'mpif.h'
+  
+  INTEGER :: i,j,ierr
+  LOGICAL :: is_terminated
+  
+!  CALL SLEEP(60)
+  PRINT *,'je suis un serveur'
+  CALL read_namelist
+  CALL init_parallel
+  CALL init_mpi_buffer
+  CALL init_wait
+  CALL init_interface_ioipsl
+  
+  CALL iom__init(nb_client,mpi_size,mpi_rank)
+  PRINT *,'je suis un serveur'
+  
+
+!  CALL MPI_BARRIER(iocomm,ierr)
+  
+  is_terminated=.FALSE.
+  
+  DO WHILE (.NOT. is_terminated)
+    CALL Check_buffer
+    CALL process_request(is_terminated)
+!    CALL wait_us(10)
+  ENDDO
+
+!  CALL MPI_BARRIER(MPI_COMM_WORLD,ierr)
+  CALL histclo
+  
+  CALL Finalize_parallel
+
+  PRINT *,"THAT'S ALL FOLK"
+  
+END PROGRAM server
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/create_template
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/create_template	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/create_template	(revision 2354)
@@ -0,0 +1,25 @@
+#! /bin/bash
+
+function template() 
+{
+  echo ${1}
+  sed "s/#TYPE#/${1}/g" vector_def.template > vector_${1}_def.inc
+  sed "s/#TYPE#/${1}/g" vector_contains.template > vector_${1}_contains.inc
+}
+
+
+template field
+template field_group
+template axis
+template axis_group
+template node
+template domain
+template grid
+template grid_group
+template file
+template file_group
+template field_dep
+template file_dep
+template field_out
+template context
+template zoom
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_attribut.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_attribut.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_attribut.f90	(revision 2354)
@@ -0,0 +1,283 @@
+MODULE mod_attribut
+  USE mod_xmlio_parameters
+  USE mod_attribut_list
+  USE mod_stdtype
+  USE string_function  
+  
+  TYPE, PUBLIC :: attribut
+    INTEGER :: object
+    INTEGER :: name
+    INTEGER :: type
+    INTEGER :: dim(7)
+    INTEGER :: ndim
+    INTEGER,POINTER :: integer0_ptr
+    INTEGER,POINTER :: integer1_ptr(:)
+    INTEGER,POINTER :: integer2_ptr(:,:)
+    REAL,POINTER    :: real0_ptr
+    REAL,POINTER    :: real1_ptr(:)
+    REAL,POINTER    :: real2_ptr(:,:)
+    LOGICAL,POINTER :: logical0_ptr
+    LOGICAL,POINTER :: logical1_ptr(:)
+    LOGICAL,POINTER :: logical2_ptr(:,:)
+    
+    CHARACTER(LEN=str_len),POINTER :: string0_ptr
+    CHARACTER(LEN=str_len),POINTER :: string1_ptr(:)
+    CHARACTER(LEN=str_len),POINTER :: string2_ptr(:,:)
+    INTEGER                        :: string_len
+    
+  END TYPE attribut
+  
+  INTERFACE attr
+    MODULE PROCEDURE attr_int0,attr_int1,attr_int2,              &
+                     attr_real0,attr_real1,attr_real2,           &
+                     attr_logical0,attr_logical1,attr_logical2,  &
+                     attr_string0,attr_string1,attr_string2
+  END INTERFACE
+                     
+CONTAINS
+  
+  FUNCTION attr_get_object(attr_name)
+  USE mod_attribut_list
+  USE mod_object
+  USE error_msg
+  IMPLICIT NONE
+    INTEGER, INTENT(IN) :: attr_name
+    INTEGER             :: attr_get_object
+    
+    IF (attr_name > field__begin .AND. attr_name < field__end) THEN
+      attr_get_object=field_object
+      RETURN
+    ENDIF
+    
+    IF (attr_name > file__begin .AND. attr_name < file__end) THEN
+      attr_get_object=file_object
+      RETURN
+    ENDIF
+
+    IF (attr_name > grid__begin .AND. attr_name < grid__end) THEN
+      attr_get_object=grid_object
+      RETURN
+    ENDIF
+
+    IF (attr_name > axis__begin .AND. attr_name < axis__end) THEN
+      attr_get_object=axis_object
+      RETURN
+    ENDIF
+    
+    IF (attr_name > zoom__begin .AND. attr_name < zoom__end) THEN
+      attr_get_object=zoom_object
+      RETURN
+    ENDIF
+
+    WRITE (message,*) 'Attribut name value :',attr_name,'is undefined'
+    CALL error("mod_attributd::attr_get_object") 
+   
+  END FUNCTION attr_get_object 
+
+  SUBROUTINE attr_deallocate(attrib)
+  IMPLICIT NONE
+  TYPE(attribut) :: attrib
+
+    SELECT CASE(attrib%type)
+       CASE (integer0)
+         DEALLOCATE(attrib%integer0_ptr)
+       CASE (integer1)
+         DEALLOCATE(attrib%integer1_ptr)
+       CASE (integer2)
+         DEALLOCATE(attrib%integer2_ptr)
+       CASE (real0)
+         DEALLOCATE(attrib%real0_ptr)
+       CASE (real1)
+         DEALLOCATE(attrib%real1_ptr)
+       CASE (real2)
+         DEALLOCATE(attrib%real2_ptr)
+       CASE (logical0)
+         DEALLOCATE(attrib%logical0_ptr)
+       CASE (logical1)
+         DEALLOCATE(attrib%logical1_ptr)
+       CASE (logical2)
+         DEALLOCATE(attrib%logical2_ptr)
+       CASE (string0)
+         DEALLOCATE(attrib%string0_ptr)
+       CASE (string1)
+         DEALLOCATE(attrib%string1_ptr)
+       CASE (string2)
+         DEALLOCATE(attrib%string2_ptr)
+    END SELECT         
+  
+  END SUBROUTINE attr_deallocate
+
+  FUNCTION attr_int0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET :: value
+    
+    TYPE(attribut) :: attr_int0
+    attr_int0%object=attr_get_object(attr_name) 
+    attr_int0%name=attr_name
+    attr_int0%type=integer0
+    attr_int0%integer0_ptr=>value
+    
+  END FUNCTION attr_int0
+
+  FUNCTION attr_int1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_int1
+    attr_int1%object=attr_get_object(attr_name) 
+    attr_int1%name=attr_name
+    attr_int1%type=integer1
+    attr_int1%integer1_ptr=>value
+    
+  END FUNCTION attr_int1    
+
+  FUNCTION attr_int2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    INTEGER,TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_int2
+    attr_int2%object=attr_get_object(attr_name) 
+    attr_int2%name=attr_name
+    attr_int2%type=integer2
+    attr_int2%integer2_ptr=>value
+    
+  END FUNCTION attr_int2
+          
+
+  FUNCTION attr_real0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET :: value
+    
+    TYPE(attribut) :: attr_real0
+    attr_real0%object=attr_get_object(attr_name) 
+    attr_real0%name=attr_name
+    attr_real0%type=real0
+    attr_real0%real0_ptr=>value
+    
+  END FUNCTION attr_real0
+
+  FUNCTION attr_real1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_real1
+    attr_real1%object=attr_get_object(attr_name) 
+    attr_real1%name=attr_name
+    attr_real1%type=real1
+    attr_real1%real1_ptr=>value
+    
+  END FUNCTION attr_real1    
+
+  FUNCTION attr_real2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    REAL,TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_real2
+    attr_real2%object=attr_get_object(attr_name) 
+    attr_real2%name=attr_name
+    attr_real2%type=REAL2
+    attr_real2%real2_ptr=>value
+    
+  END FUNCTION attr_real2
+  
+    FUNCTION attr_logical0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET :: value
+    
+    TYPE(attribut) :: attr_logical0
+    attr_logical0%object=attr_get_object(attr_name) 
+    attr_logical0%name=attr_name
+    attr_logical0%type=logical0
+    attr_logical0%logical0_ptr=>value
+    
+  END FUNCTION attr_logical0
+
+  FUNCTION attr_logical1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_logical1
+    attr_logical1%object=attr_get_object(attr_name) 
+    attr_logical1%name=attr_name
+    attr_logical1%type=logical1
+    attr_logical1%logical1_ptr=>value
+    
+  END FUNCTION attr_logical1    
+
+  FUNCTION attr_logical2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    LOGICAL,TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_logical2
+    attr_logical2%object=attr_get_object(attr_name) 
+    attr_logical2%name=attr_name
+    attr_logical2%type=logical2
+    attr_logical2%logical2_ptr=>value
+    
+  END FUNCTION attr_logical2
+  
+
+  FUNCTION attr_string0(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET :: value
+    TYPE(attribut) :: attr_string0
+
+      attr_string0%object=attr_get_object(attr_name) 
+      attr_string0%name=attr_name
+      attr_string0%type=string0
+      attr_string0%string_len=LEN(value)
+      attr_string0%string0_ptr=>value
+    
+  END FUNCTION attr_string0
+
+  FUNCTION attr_string1(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET :: value(:)
+    
+    TYPE(attribut) :: attr_string1
+    attr_string1%object=attr_get_object(attr_name) 
+    attr_string1%name=attr_name
+    attr_string1%type=string1
+    attr_string1%string_len=LEN(value)
+    attr_string1%string1_ptr=>value
+    
+  END FUNCTION attr_string1    
+
+  FUNCTION attr_string2(attr_name,value) 
+  USE mod_stdtype
+    IMPLICIT NONE
+    INTEGER :: attr_name
+    CHARACTER(LEN=*),TARGET :: value(:,:)
+    
+    TYPE(attribut) :: attr_string2
+    attr_string2%object=attr_get_object(attr_name) 
+    attr_string2%name=attr_name
+    attr_string2%type=string2
+    attr_string2%string_len=LEN(value)
+    attr_string2%string2_ptr=>value
+    
+  END FUNCTION attr_string2
+ 
+END MODULE mod_attribut
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_attribut_list.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_attribut_list.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_attribut_list.f90	(revision 2354)
@@ -0,0 +1,7 @@
+MODULE mod_attribut_list
+  USE mod_field_attribut
+  USE mod_file_attribut
+  USE mod_axis_attribut
+  USE mod_grid_attribut
+  USE mod_zoom_attribut
+END MODULE mod_attribut_list
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis.f90	(revision 2354)
@@ -0,0 +1,332 @@
+MODULE mod_axis
+
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+
+  
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: axis
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    INTEGER                     :: size
+    LOGICAL                     :: has_size
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    CHARACTER(len=str_len)      :: unit
+    LOGICAL                     :: has_unit
+    LOGICAL                     :: positive
+    LOGICAL                     :: has_positive
+    REAL, DIMENSION(:), POINTER :: values
+    LOGICAL                     :: has_values
+
+  END TYPE axis
+
+  INCLUDE 'vector_axis_def.inc'
+  
+  TYPE(vector_axis),POINTER,SAVE             :: axis_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE axis__set_attribut
+    MODULE PROCEDURE axis__set_attribut_id,axis__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_axis_contains.inc'
+
+  SUBROUTINE axis__swap_context(saved_axis_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_axis),POINTER          :: saved_axis_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    axis_ids=>saved_axis_ids
+    ids=>saved_ids
+    
+  END SUBROUTINE axis__swap_context
+
+  SUBROUTINE axis__init
+  IMPLICIT NONE
+    
+    CALL vector_axis__new(axis_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE axis__init
+  
+  SUBROUTINE axis__get(Id,Pt_axis)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(axis),POINTER              :: Pt_axis
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_axis=>axis_ids%at(Pos)%Pt
+    ELSE
+      Pt_axis=>NULL()
+    ENDIF
+    
+  END SUBROUTINE axis__get
+  
+  SUBROUTINE axis__new(pt_axis,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(axis), POINTER           :: pt_axis
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+   
+   pt_axis%has_id          = .FALSE.
+   pt_axis%has_name        = .FALSE.
+   pt_axis%has_size        = .FALSE.
+   pt_axis%has_description = .FALSE.
+   pt_axis%has_unit        = .FALSE.
+   pt_axis%has_values      = .FALSE.
+   pt_axis%has_positive    = .FALSE. 
+     
+   IF (PRESENT(Id)) THEN
+     Pt_axis%id=TRIM(ADJUSTL(Id))
+     Pt_axis%has_id=.TRUE.
+     CALL vector_axis__set_new(axis_Ids,Pt_axis,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+
+ END SUBROUTINE axis__new
+
+  SUBROUTINE axis__set(pt_axis, name, description, unit, a_size, values, positive)
+  IMPLICIT NONE
+    TYPE(axis), POINTER         :: pt_axis
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: description
+    CHARACTER(len=*)  ,OPTIONAL :: unit
+    INTEGER           ,OPTIONAL :: a_size
+    REAL, DIMENSION(:),OPTIONAL :: values
+    LOGICAL           ,OPTIONAL :: positive
+
+    IF (PRESENT(name)) THEN
+        pt_axis%name=TRIM(ADJUSTL(name))
+        pt_axis%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_axis%description=TRIM(ADJUSTL(description))
+        pt_axis%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(unit)) then
+        pt_axis%unit=TRIM(ADJUSTL(unit))
+        pt_axis%has_unit = .TRUE.
+    ENDIF
+
+    IF (PRESENT(a_size)) then
+        pt_axis%size=a_size
+        pt_axis%has_size = .TRUE.
+    ENDIF
+    
+    IF (PRESENT(values)) then
+        IF (pt_axis%has_values) DEALLOCATE(pt_axis%values)  
+        ALLOCATE(pt_axis%values(size(values)))
+        pt_axis%values(:)=values(:)
+        pt_axis%has_values = .TRUE.
+    ENDIF
+
+    IF (PRESENT(positive)) then
+        pt_axis%positive=positive
+        pt_axis%has_positive = .TRUE.
+    ENDIF
+
+  END SUBROUTINE axis__set
+
+  SUBROUTINE axis__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(axis),POINTER              :: Pt_axis
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_axis=>axis_ids%at(Pos)%Pt
+      CALL axis__set_attribut_pt(Pt_axis,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'axis id :',id,'is undefined'
+        CALL error('mod_axis::axis__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE axis__set_attribut_id
+      
+  SUBROUTINE axis__set_attribut_pt(Pt_axis,attrib)
+  USE mod_attribut
+  USE mod_axis_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(axis),POINTER        :: Pt_axis
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (axis__name)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,name=attrib%string0_ptr) ; RETURN
+      CASE (axis__description)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,description=attrib%string0_ptr) ; RETURN
+      CASE (axis__unit)
+        IF (attrib%type==string0) CALL  axis__set(pt_axis,unit=attrib%string0_ptr) ; RETURN
+      CASE (axis__size)
+        IF (attrib%type==integer0) CALL  axis__set(pt_axis,a_size=attrib%integer0_ptr) ; RETURN
+      CASE (axis__values)
+        IF (attrib%type==real1) CALL  axis__set(pt_axis,values=attrib%real1_ptr) ; RETURN
+      CASE (axis__positive)
+        IF (attrib%type==logical0) CALL  axis__set(pt_axis,positive=attrib%logical0_ptr) ; RETURN
+       END SELECT
+
+     WRITE(message,*) 'axis attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_axis::axis__set_attribut')
+    
+  END SUBROUTINE axis__set_attribut_pt
+  
+  SUBROUTINE axis__print(pt_axis)
+  IMPLICIT NONE
+    TYPE(axis), POINTER         :: pt_axis
+
+    PRINT *,"---- AXIS ----"
+    IF (pt_axis%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_axis%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_axis%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_axis%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+    
+    IF (pt_axis%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_axis%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+ 
+    IF (pt_axis%has_unit) THEN
+      PRINT *,"unit = ",TRIM(pt_axis%unit)
+    ELSE
+      PRINT *,"unit undefined"
+    ENDIF
+
+    IF (pt_axis%has_size) THEN
+      PRINT *,"size = ",pt_axis%size
+    ELSE
+      PRINT *,"size undefined"
+    ENDIF
+
+    IF (pt_axis%has_values) THEN
+      PRINT *,"values = ",pt_axis%values
+    ELSE
+      PRINT *,"values undefined"
+    ENDIF
+
+    IF (pt_axis%has_positive) THEN
+      PRINT *,"positive = ",pt_axis%positive
+    ELSE
+      PRINT *,"positive undefined"
+    ENDIF
+
+  END SUBROUTINE axis__print
+
+
+  SUBROUTINE axis__apply_default(pt_axis_default, pt_axis_in, pt_axis_out)
+
+    TYPE(axis), POINTER :: pt_axis_default, pt_axis_in, pt_axis_out
+
+    IF (pt_axis_in%has_name) THEN
+        pt_axis_out%name=pt_axis_in%name
+        pt_axis_out%has_name=.TRUE.
+    ELSE IF ( pt_axis_default%has_name) THEN
+        pt_axis_out%name=pt_axis_default%name
+        pt_axis_out%has_name=.TRUE.
+    ELSE
+        pt_axis_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_axis_in%has_description) THEN
+        pt_axis_out%description=pt_axis_in%description
+        pt_axis_out%has_description=.TRUE.
+    ELSE IF ( pt_axis_default%has_description ) THEN
+        pt_axis_out%description=pt_axis_default%description
+        pt_axis_out%has_description=.TRUE.
+    ELSE
+        pt_axis_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_unit) THEN
+        pt_axis_out%unit=pt_axis_in%unit
+        pt_axis_out%has_unit=.TRUE.
+    ELSE IF ( pt_axis_default%has_unit ) THEN
+        pt_axis_out%unit=pt_axis_default%unit
+        pt_axis_out%has_unit=.TRUE.
+    ELSE
+        pt_axis_out%has_unit=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_size) THEN
+        pt_axis_out%size=pt_axis_in%size
+        pt_axis_out%has_size=.TRUE.
+    ELSE IF ( pt_axis_default%has_size ) THEN
+        pt_axis_out%size=pt_axis_default%size
+        pt_axis_out%has_size=.TRUE.
+    ELSE
+        pt_axis_out%has_size=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_values) THEN
+        pt_axis_out%values(:)=pt_axis_in%values(:)
+        pt_axis_out%has_values=.TRUE.
+    ELSE IF ( pt_axis_default%has_values ) THEN
+        pt_axis_out%values(:)=pt_axis_default%values(:)
+        pt_axis_out%has_values=.TRUE.
+    ELSE
+        pt_axis_out%has_values=.FALSE.
+    ENDIF
+
+    IF (pt_axis_in%has_positive) THEN
+        pt_axis_out%positive=pt_axis_in%positive
+        pt_axis_out%has_positive=.TRUE.
+    ELSE IF ( pt_axis_default%has_positive ) THEN
+        pt_axis_out%positive=pt_axis_default%positive
+        pt_axis_out%has_positive=.TRUE.
+    ELSE
+        pt_axis_out%has_positive=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE axis__apply_default
+
+  SUBROUTINE axis__check(pt_axis)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(axis), POINTER :: pt_axis
+      
+    IF (.NOT. pt_axis%has_name) THEN
+      IF (pt_axis%has_id) THEN
+        pt_axis%name=TRIM(pt_axis%id)
+      ELSE
+        WRITE(message,*) "Axis has no name and no id" 
+        CALL error("mod_axis::axis__check")
+      ENDIF 
+    ENDIF
+ 
+ END SUBROUTINE axis__Check
+
+END MODULE mod_axis
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_attribut.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_attribut.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_attribut.f90	(revision 2354)
@@ -0,0 +1,15 @@
+MODULE mod_axis_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: axis__begin = axis_object + 10
+  
+  INTEGER,PARAMETER :: axis__name = axis_object + 11
+  INTEGER,PARAMETER :: axis__description = axis_object + 12
+  INTEGER,PARAMETER :: axis__unit = axis_object + 13
+  INTEGER,PARAMETER :: axis__size = axis_object + 14
+  INTEGER,PARAMETER :: axis__positive = axis_object + 15
+  INTEGER,PARAMETER :: axis__values = axis_object + 16
+
+  INTEGER,PARAMETER :: axis__end = axis_object + 17
+  
+END MODULE mod_axis_attribut
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_definition.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_definition.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_definition.f90	(revision 2354)
@@ -0,0 +1,24 @@
+MODULE mod_axis_definition
+  USE mod_axis_group
+  
+  TYPE(axis_group),SAVE,POINTER :: axis_definition
+  
+CONTAINS
+
+  SUBROUTINE axis_definition__swap_context(saved_axis_definition)      
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER :: saved_axis_definition
+    
+    axis_definition=>saved_axis_definition
+    
+  END SUBROUTINE axis_definition__swap_context 
+
+  SUBROUTINE axis_definition__Init
+  USE mod_axis_group
+  IMPLICIT NONE
+  
+    CALL axis_group__new(axis_definition,"axis_definition")
+    
+  END SUBROUTINE axis_definition__Init
+        
+END MODULE mod_axis_definition
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_group.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_group.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_axis_group.f90	(revision 2354)
@@ -0,0 +1,242 @@
+MODULE mod_axis_group
+  USE mod_axis
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE axis_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_axis_group), POINTER          :: groups
+    TYPE(vector_axis),POINTER                 :: axis     
+    TYPE(axis), POINTER                       :: default_attribut
+  END TYPE axis_group
+
+  INCLUDE "vector_axis_group_def.inc"  
+
+  TYPE(vector_axis_group),POINTER       :: axis_group_Ids
+  TYPE(sorted_list),POINTER,PRIVATE     :: Ids 
+
+  INTERFACE axis_group__set_attribut
+    MODULE PROCEDURE axis_group__set_attribut_id,axis_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_axis_group_contains.inc"
+
+  SUBROUTINE axis_group__swap_context(saved_axis_group_Ids,saved_ids)
+  IMPLICIT NONE
+  TYPE(vector_axis_group),POINTER       :: saved_axis_group_Ids
+  TYPE(sorted_list),POINTER             :: saved_Ids 
+   
+   axis_group_ids=>saved_axis_group_ids
+   ids=>saved_ids
+   
+  END SUBROUTINE axis_group__swap_context
+
+  SUBROUTINE axis_group__init
+  IMPLICIT NONE
+    
+    CALL vector_axis_group__new(axis_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE axis_group__init
+
+  SUBROUTINE axis_group__get(Id,Pt_ag)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(axis_group),POINTER        :: Pt_ag
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_ag=>axis_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_ag=>NULL()
+    ENDIF
+    
+  END SUBROUTINE axis_group__get
+
+
+  SUBROUTINE axis_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(axis_group),POINTER             :: Pt_ag
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_ag=>axis_group_ids%at(Pos)%Pt
+      CALL axis_group__set_attribut(Pt_ag,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'axis group id :',id,'is undefined'
+        CALL error('mod_axis_group::axis_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE axis_group__set_attribut_id
+  
+  SUBROUTINE axis_group__set_attribut_pt(pt_ag,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER :: Pt_ag
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==axis_object) THEN
+      CALL axis__set_attribut(pt_ag%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE axis_group__set_attribut_pt
+      
+  RECURSIVE SUBROUTINE axis_group__new(Pt_ag,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER                :: Pt_ag
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_ag%groups)
+    ALLOCATE(Pt_ag%axis)
+    ALLOCATE(Pt_ag%default_attribut)
+    
+    CALL vector_axis_group__new(Pt_ag%groups)
+    CALL vector_axis__new(Pt_ag%axis)
+    CALL axis__new(Pt_ag%default_attribut)
+    Pt_ag%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_ag%id=TRIM(Id)
+      Pt_ag%has_id=.TRUE.
+      CALL vector_axis_group__set_new(axis_group_Ids,Pt_ag,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE axis_group__new
+
+      
+  SUBROUTINE axis_group__get_new_group(Pt_ag,Pt_ag_out,Id)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER             :: Pt_ag
+    TYPE(axis_group),POINTER             :: Pt_ag_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_axis_group__get_new(Pt_ag%groups,Pt_ag_out)
+    CALL axis_group__new(Pt_ag_out)
+
+    IF (PRESENT(id)) THEN
+      CALL axis_group__new(Pt_ag_out,Id)
+    ELSE
+      CALL axis_group__new(Pt_ag_out)
+    ENDIF
+    
+  END SUBROUTINE axis_group__get_new_group
+
+  
+  SUBROUTINE axis_group__get_new_axis(Pt_ag,Pt_a_out,Id)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER            :: Pt_ag
+    TYPE(axis),POINTER                  :: Pt_a_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_axis__get_new(Pt_ag%axis,Pt_a_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL axis__new(Pt_a_out,Id)
+    ELSE
+      CALL axis__new(Pt_a_out)
+    ENDIF
+    
+  END SUBROUTINE axis_group__get_new_axis
+  
+  
+  SUBROUTINE axis_group__get_default_attrib(Pt_ag,Pt_a)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER  :: Pt_ag
+    TYPE(axis),POINTER        :: Pt_a
+    
+    Pt_a=>Pt_ag%default_attribut
+  END SUBROUTINE axis_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE axis_group__apply_default(Pt_ag,default)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER           :: Pt_ag
+    TYPE(axis),POINTER,OPTIONAL        :: default
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL axis__apply_default(default,Pt_ag%default_attribut,Pt_ag%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__apply_default(Pt_ag%groups%at(i)%pt,Pt_ag%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_ag%axis%size
+      CALL axis__apply_default(Pt_ag%default_attribut,Pt_ag%axis%at(i)%pt,Pt_ag%axis%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE axis_group__apply_default
+
+  RECURSIVE SUBROUTINE axis_group__print(Pt_ag)
+  IMPLICIT NONE
+    TYPE(axis_group),POINTER  :: Pt_ag
+   
+    INTEGER :: i
+    
+    PRINT *,"--- AXIS GROUP ---"
+    IF (pt_ag%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_ag%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"axis default attribut :"
+    CALL axis__print(Pt_ag%default_attribut)    
+
+    PRINT *,"owned axis groups :",Pt_ag%groups%size      
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__print(Pt_ag%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned axis :",Pt_ag%axis%size      
+    DO i=1,Pt_ag%axis%size
+      CALL axis__print(Pt_ag%axis%at(i)%pt)
+    ENDDO
+    PRINT *,"------------"
+    
+  END SUBROUTINE axis_group__print
+
+  RECURSIVE SUBROUTINE axis_group__Check(Pt_ag)
+  IMPLICIT NONE
+  
+    TYPE(axis_group),POINTER  :: Pt_ag
+    INTEGER :: i
+   
+    DO i=1,Pt_ag%groups%size
+      CALL axis_group__check(pt_ag%groups%at(i)%pt)
+    ENDDO
+
+    DO i=1,Pt_ag%axis%size
+      CALL axis__check(pt_ag%axis%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE axis_group__check     
+   
+END MODULE mod_axis_group
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_context.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_context.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_context.f90	(revision 2354)
@@ -0,0 +1,233 @@
+MODULE mod_context
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_field
+  USE mod_field_group
+  USE mod_field_definition
+  USE mod_file
+  USE mod_file_group
+  USE mod_file_definition
+  USE mod_grid
+  USE mod_zoom
+  USE mod_grid_group
+  USE mod_grid_definition
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_axis_definition
+  USE mod_dependency
+  USE mod_time_parameters
+
+
+  INTERFACE context__swap
+    MODULE PROCEDURE context__swap_id,context__swap_pt
+  END INTERFACE  
+  
+  TYPE, PUBLIC :: context
+    CHARACTER(len=str_len)         :: id
+    INTEGER                        :: number
+  
+    TYPE(vector_field),POINTER        :: field__field_Ids
+    TYPE(sorted_list),POINTER         :: field__Ids
+    TYPE(vector_field_group),POINTER  :: field_group__field_group_ids
+    TYPE(sorted_list),POINTER         :: field_group__Ids
+    TYPE(field_group),POINTER         :: field_definition__field_def
+    TYPE(vector_file),POINTER         :: file__file_Ids
+    TYPE(sorted_list),POINTER         :: file__Ids
+    TYPE(vector_file_group),POINTER   :: file_group__file_group_Ids
+    TYPE(sorted_list),POINTER         :: file_group__Ids 
+    TYPE(file_group),POINTER          :: file_definition__file_def 
+    TYPE(vector_grid),POINTER         :: grid__grid_Ids
+    TYPE(sorted_list),POINTER         :: grid__Ids 
+    TYPE(vector_zoom),POINTER         :: zoom__zoom_Ids
+    TYPE(sorted_list),POINTER         :: zoom__Ids 
+    TYPE(vector_grid_group),POINTER   :: grid_group__grid_group_Ids
+    TYPE(sorted_list),POINTER         :: grid_group__Ids 
+    TYPE(grid_group),POINTER          :: grid_definition__grid_def
+    TYPE(vector_axis),POINTER         :: axis__axis_Ids
+    TYPE(sorted_list),POINTER         :: axis__Ids 
+    TYPE(vector_axis_group),POINTER   :: axis_group__axis_group_Ids
+    TYPE(sorted_list),POINTER         :: axis_group__Ids 
+    TYPE(axis_group),POINTER          :: axis_definition__axis_def
+    TYPE(vector_file_dep),POINTER     :: dependency__file_enabled
+    TYPE(vector_field_out),POINTER    :: dependency__field_enabled 
+    TYPE(vector_field_dep),POINTER    :: dependency__field_id
+    TYPE(sorted_list),POINTER         :: dependency__sorted_id 
+    INTEGER,POINTER                   :: time_param__initial_timestep
+    REAL,POINTER                      :: time_param__initial_date
+    REAL,POINTER                      :: time_param__timestep_value 
+    INTEGER,POINTER                   :: time_param__timestep_number
+
+  END TYPE context
+  
+  INCLUDE 'vector_context_def.inc'
+  TYPE(vector_context),SAVE,POINTER  :: context_ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE :: Ids
+
+ 
+  CONTAINS
+    INCLUDE 'vector_context_contains.inc'
+    
+    SUBROUTINE context__init
+    IMPLICIT NONE
+
+      ALLOCATE(context_Ids)
+      ALLOCATE(Ids)
+
+      CALL vector_context__new(context_Ids)
+      CALL sorted_list__new(ids)
+
+    END SUBROUTINE context__init
+
+    SUBROUTINE context__get(Id,Pt_context)
+      USE string_function
+      IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER              :: Pt_context
+
+      INTEGER                         :: Pos
+      LOGICAL                         :: success
+    
+      CALL sorted_list__find(Ids,hash(Id),Pos,success)
+      IF (success) THEN
+        Pt_context=>context_ids%at(Pos)%Pt
+      ELSE
+        Pt_context=>NULL()
+      ENDIF
+    
+    END SUBROUTINE context__get
+
+    SUBROUTINE context__get_new(Id,pt_context)
+    USE string_function
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER              :: Pt_context
+
+      INTEGER                         :: Pos
+      LOGICAL                         :: success
+      
+      CALL sorted_list__find(Ids,hash(Id),Pos,success)
+      IF (success) THEN
+        Pt_context=>context_ids%at(Pos)%Pt
+      ELSE
+        CALL vector_context__get_new(context_ids,pt_context,Pos)
+        pt_context%number=Pos
+        Pt_context%id=Id
+        CALL sorted_list__Add(Ids,hash(Id),Pos)
+        
+        ALLOCATE(pt_context%field__field_Ids )
+        ALLOCATE(pt_context%field__Ids )
+        ALLOCATE(pt_context%field_group__field_group_ids )
+        ALLOCATE(pt_context%field_group__field_group_ids )
+        ALLOCATE(pt_context%field_group__Ids )
+        ALLOCATE(pt_context%field_definition__field_def )
+        ALLOCATE(pt_context%file__file_Ids)
+        ALLOCATE(pt_context%file__Ids)
+        ALLOCATE(pt_context%file_group__file_group_Ids)
+        ALLOCATE(pt_context%file_group__Ids) 
+        ALLOCATE(pt_context%file_definition__file_def) 
+        ALLOCATE(pt_context%grid__grid_Ids)
+        ALLOCATE(pt_context%grid__Ids) 
+        ALLOCATE(pt_context%zoom__zoom_Ids)
+        ALLOCATE(pt_context%zoom__Ids) 
+        ALLOCATE(pt_context%grid_group__grid_group_Ids)
+        ALLOCATE(pt_context%grid_group__Ids) 
+        ALLOCATE(pt_context%grid_definition__grid_def)
+        ALLOCATE(pt_context%axis__axis_Ids)
+        ALLOCATE(pt_context%axis__Ids) 
+        ALLOCATE(pt_context%axis_group__axis_group_Ids)
+        ALLOCATE(pt_context%axis_group__Ids) 
+        ALLOCATE(pt_context%axis_definition__axis_def)
+        ALLOCATE(pt_context%dependency__file_enabled)
+        ALLOCATE(pt_context%dependency__field_enabled) 
+        ALLOCATE(pt_context%dependency__field_id)
+        ALLOCATE(pt_context%dependency__sorted_id)  
+        ALLOCATE(pt_context%time_param__initial_timestep)
+        ALLOCATE(pt_context%time_param__initial_date)
+        ALLOCATE(pt_context%time_param__timestep_value) 
+        ALLOCATE(pt_context%time_param__timestep_number)
+
+        CALL context__swap(pt_context)
+        
+        CALL field__init
+        CALL field_group__Init
+        CALL field_definition__Init
+
+        CALL axis__init
+        CALL axis_group__Init
+        CALL axis_definition__Init
+
+        CALL grid__init
+        CALL grid_group__Init
+        CALL grid_definition__Init
+
+        CALL zoom__init
+
+        CALL file__init
+        CALL file_group__Init
+        CALL file_definition__Init
+
+      ENDIF
+
+    END SUBROUTINE context__get_new
+
+
+    SUBROUTINE context__create(Id)
+    IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      
+      TYPE(context),POINTER              :: Pt_context
+
+      CALL context__get(Id,Pt_context)
+      IF (.NOT. ASSOCIATED(Pt_context)) CALL context__get_new(Id,Pt_context)
+      
+!      CALL field__init
+!      CALL field_group__init
+!      CALL field_definition__init
+      
+     END SUBROUTINE context__create
+
+     
+    SUBROUTINE context__swap_id(Id)
+    USE mod_field
+      IMPLICIT NONE
+      CHARACTER(LEN=*),INTENT(IN)     :: Id
+      TYPE(context),POINTER       :: Pt_context
+
+      INTEGER :: number
+      
+      CALL context__get(Id,Pt_context)
+      IF (.NOT. ASSOCIATED(Pt_context)) THEN
+!!      error message
+      ENDIF
+      
+      CALL context__swap(pt_context)  
+
+    END SUBROUTINE context__swap_id
+
+    SUBROUTINE context__swap_pt(Pt_context)
+    USE mod_field
+      IMPLICIT NONE
+      TYPE(context),POINTER       :: Pt_context
+
+      CALL field__swap_context(Pt_context%field__field_Ids ,Pt_context%field__Ids)
+      CALL field_group__swap_context(Pt_context%field_group__field_group_ids ,Pt_context%field_group__Ids)
+      CALL field_definition__swap_context(Pt_context%field_definition__field_def)
+      CALL file__swap_context(Pt_context%file__file_Ids,Pt_context%file__Ids)
+      CALL file_group__swap_context(Pt_context%file_group__file_group_Ids,Pt_context%file_group__Ids)
+      CALL file_definition__swap_context(Pt_context%file_definition__file_def) 
+      CALL grid__swap_context(pt_context%grid__grid_Ids,pt_context%grid__Ids) 
+      CALL zoom__swap_context(pt_context%zoom__zoom_Ids,pt_context%zoom__Ids) 
+      CALL grid_group__swap_context(pt_context%grid_group__grid_group_Ids,pt_context%grid_group__Ids) 
+      CALL grid_definition__swap_context(pt_context%grid_definition__grid_def)
+      CALL axis__swap_context(pt_context%axis__axis_Ids,pt_context%axis__Ids) 
+      CALL axis_group__swap_context(pt_context%axis_group__axis_group_Ids,pt_context%axis_group__Ids) 
+      CALL axis_definition__swap_context(pt_context%axis_definition__axis_def)
+      CALL dependency__swap_context(pt_context%dependency__file_enabled,pt_context%dependency__field_enabled,  &
+                                    pt_context%dependency__field_id,pt_context%dependency__sorted_id)
+      CALL time_parameters__swap_context(pt_context%time_param__initial_timestep,pt_context%time_param__initial_date,  &
+                                         pt_context%time_param__timestep_value,pt_context%time_param__timestep_number)
+                                    
+    END SUBROUTINE context__swap_pt
+
+
+END MODULE mod_context
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_dependency.f90	(revision 2354)
@@ -0,0 +1,247 @@
+MODULE mod_dependency
+USE mod_field
+USE mod_file
+USE mod_grid
+USE mod_axis
+USE mod_sorted_list
+USE mod_zoom
+
+TYPE file_dep
+  TYPE(file),POINTER           :: file
+  INTEGER                      :: hash
+  TYPE(vector_field),POINTER   :: fields
+  TYPE(vector_grid),POINTER    :: grids
+  TYPE(vector_zoom),POINTER    :: zooms
+  TYPE(vector_axis),POINTER    :: axis
+END TYPE file_dep
+
+TYPE field_dep
+  TYPE(field),POINTER :: field
+  INTEGER             :: hash
+  
+  TYPE(vector_field_out),POINTER   :: field_out
+END TYPE field_dep
+
+TYPE field_out
+  TYPE(Field), POINTER  :: field
+  TYPE(file),  POINTER  :: file
+  TYPE(axis),  POINTER  :: axis
+  TYPE(grid),  POINTER  :: grid
+  TYPE(zoom),  POINTER  :: zoom
+END TYPE field_out
+
+INCLUDE 'vector_field_dep_def.inc'
+INCLUDE 'vector_file_dep_def.inc'
+INCLUDE 'vector_field_out_def.inc'
+
+TYPE(vector_file_dep),POINTER,SAVE      :: file_enabled
+TYPE(vector_field_out),POINTER,SAVE     :: field_enabled 
+TYPE(vector_field_dep),POINTER,SAVE     :: field_id
+
+ 
+TYPE(sorted_list),POINTER,SAVE :: sorted_id
+
+CONTAINS
+
+INCLUDE 'vector_field_dep_contains.inc'
+INCLUDE 'vector_file_dep_contains.inc'
+INCLUDE 'vector_field_out_contains.inc'
+
+  
+  SUBROUTINE dependency__swap_context(saved_file_enabled,saved_field_enabled,save_field_id,saved_sorted_id)  
+  IMPLICIT NONE
+    TYPE(vector_file_dep),POINTER      :: saved_file_enabled
+    TYPE(vector_field_out),POINTER     :: saved_field_enabled 
+    TYPE(vector_field_dep),POINTER     :: save_field_id
+    TYPE(sorted_list),POINTER          :: saved_sorted_id  
+    
+    file_enabled=>saved_file_enabled   
+    field_enabled=>saved_field_enabled
+    field_id=>save_field_id
+    sorted_id=>saved_sorted_id
+      
+  END SUBROUTINE dependency__swap_context
+  
+  SUBROUTINE set_dependency
+  IMPLICIT NONE
+  
+   CALL set_file_dependency
+   CALL set_field_enabled
+   CALL set_field_dependency
+
+  END SUBROUTINE set_dependency
+  
+  
+  RECURSIVE SUBROUTINE set_file_dependency(Pt_file_group)
+  USE mod_file_definition
+  USE mod_file_group
+  USE string_function
+  USE mod_sorted_list
+  IMPLICIT NONE
+    TYPE (file_group),POINTER,OPTIONAL :: pt_file_group 
+    TYPE (file_group),POINTER          :: Pt_fg
+    TYPE (file)     ,POINTER           :: Pt_file
+    TYPE (file_dep),POINTER            :: Pt_file_dep
+    TYPE (sorted_list),POINTER         :: sorted_axis
+    TYPE (sorted_list),POINTER         :: sorted_grid
+    TYPE (sorted_list),POINTER         :: sorted_zoom
+    INTEGER                            :: i
+    INTEGER                            :: j
+    
+    ALLOCATE(sorted_axis)
+    ALLOCATE(sorted_grid)
+    ALLOCATE(sorted_zoom)
+    
+    IF (PRESENT(Pt_file_group)) THEN
+      Pt_fg=>Pt_file_group
+    ELSE
+      CALL vector_file_dep__new(file_enabled)
+      Pt_fg=>file_definition
+    ENDIF
+    
+    DO i=1,Pt_fg%groups%size
+      CALL set_file_dependency(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      Pt_file=>pt_fg%files%at(i)%pt
+      IF (Pt_file%enabled) THEN
+        CALL vector_file_dep__get_new(file_enabled,Pt_file_dep)
+        
+        ALLOCATE(Pt_file_dep%fields)
+        ALLOCATE(Pt_file_dep%grids)
+        ALLOCATE(Pt_file_dep%zooms)
+        ALLOCATE(Pt_file_dep%axis)
+        pt_file_dep%file=>pt_file
+        pt_file_dep%hash=hash(pt_file%id)
+        CALL vector_field__new(Pt_file_dep%fields)
+        CALL vector_grid__new(Pt_file_dep%grids)
+        CALL vector_zoom__new(Pt_file_dep%zooms)
+        CALL vector_axis__new(Pt_file_dep%axis)
+        CALL sorted_list__new(sorted_axis)
+        CALL sorted_list__new(sorted_grid)
+        CALL sorted_list__new(sorted_zoom)
+        
+        CALL Treat_field_group(pt_file%field_list)
+        
+        CALL sorted_list__delete(sorted_axis)
+        CALL sorted_list__delete(sorted_grid)
+        CALL sorted_list__delete(sorted_zoom)
+      ENDIF
+    ENDDO
+    
+    CONTAINS 
+      RECURSIVE SUBROUTINE treat_field_group(pt_fg)
+      IMPLICIT NONE  
+        TYPE(field_group),POINTER :: Pt_fg
+        INTEGER                   :: i
+        
+        DO i=1,Pt_fg%groups%size
+          CALL treat_field_group(Pt_fg%groups%at(i)%pt)
+        ENDDO
+        
+        DO i=1,Pt_fg%fields%size
+          CALL treat_field(Pt_fg%fields%at(i)%pt)
+        ENDDO
+      END SUBROUTINE treat_field_group
+      
+      
+      SUBROUTINE treat_field(pt_field)
+      IMPLICIT NONE  
+        TYPE(field),POINTER :: Pt_field
+        LOGICAL             :: found
+        INTEGER             :: Pos
+
+        IF (Pt_field%enabled .AND. Pt_field%level <= Pt_file%output_level) THEN
+          CALL vector_field__set_new(Pt_file_dep%fields,Pt_field)
+  
+          IF (Pt_field%has_grid) THEN
+            CALL sorted_list__find(sorted_grid,hash(Pt_field%grid%id),pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_grid__set_new(pt_file_dep%grids,Pt_field%grid,pos)
+              CALL sorted_list__add(sorted_grid,hash(Pt_field%grid%id),pos)
+            ENDIF
+          ENDIF
+
+          IF (Pt_field%has_zoom) THEN
+            CALL sorted_list__find(sorted_zoom,hash(Pt_field%zoom%id),pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_zoom__set_new(pt_file_dep%zooms,Pt_field%zoom,pos)
+              CALL sorted_list__add(sorted_zoom,hash(Pt_field%zoom%id),pos)
+            ENDIF
+          ENDIF
+  
+          IF (Pt_field%has_axis) THEN
+            CALL sorted_list__find(sorted_axis,hash(Pt_field%axis%id),Pos,found)
+            IF (.NOT. found) THEN 
+              CALL vector_axis__set_new(Pt_file_dep%axis,Pt_field%axis,pos)
+              CALL sorted_list__add(sorted_axis,hash(Pt_field%axis%id),pos)
+            ENDIF
+          ENDIF
+        ENDIF
+      
+      END SUBROUTINE treat_field
+      
+  END SUBROUTINE set_file_dependency
+  
+  SUBROUTINE set_field_enabled
+  IMPLICIT NONE
+  TYPE(file_dep),POINTER   :: pt_file_dep
+  TYPE(field_out),POINTER  :: pt_field_out
+  INTEGER                  :: i
+  INTEGER                  :: j
+  
+    CALL vector_field_out__new(field_enabled)
+    
+    DO i=1,file_enabled%size
+      pt_file_dep=>file_enabled%at(i)%pt
+      DO j=1,pt_file_dep%fields%size
+        CALL vector_field_out__get_new(field_enabled,pt_field_out)
+        pt_field_out%field=>pt_file_dep%fields%at(j)%pt
+        pt_field_out%file=>pt_file_dep%file
+        pt_field_out%axis=>pt_field_out%field%axis
+        pt_field_out%grid=>pt_field_out%field%grid
+        pt_field_out%zoom=>pt_field_out%field%zoom
+      ENDDO
+    ENDDO
+   
+      
+  END SUBROUTINE set_field_enabled
+      
+  SUBROUTINE set_field_dependency
+  USE string_function
+  IMPLICIT NONE
+  TYPE(field_out),POINTER :: pt_field_out
+  TYPE(field_dep),POINTER :: pt_field_dep
+  TYPE(field),POINTER     :: pt_field
+  TYPE(field),POINTER     :: pt_field_base
+  INTEGER :: pos
+  LOGICAL :: found
+  INTEGER :: i
+  
+    CALL vector_field_dep__new(field_id)
+    CALL sorted_list__new(sorted_id)
+    
+    DO i=1,field_enabled%size
+      pt_field_out=>field_enabled%at(i)%pt
+      pt_field=>pt_field_out%field
+      pt_field_base=>pt_field%field_base
+      CALL sorted_list__find(sorted_id,hash(pt_field_base%id),pos,found)
+      IF (.NOT. found) THEN
+        CALL vector_field_dep__get_new(field_id,pt_field_dep,pos)
+        ALLOCATE(pt_field_dep%field_out)
+        CALL vector_field_out__new(pt_field_dep%field_out)
+        pt_field_dep%field=>pt_field_base       
+        CALL sorted_list__add(sorted_id,hash(pt_field_base%id),pos)
+      ELSE
+        pt_field_dep=>field_id%at(pos)%pt
+      ENDIF
+      
+      CALL vector_field_out__set_new(pt_field_dep%field_out,pt_field_out) 
+    ENDDO  
+      
+  END SUBROUTINE set_field_dependency     
+      
+    
+    
+END MODULE mod_dependency
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_domain.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_domain.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_domain.f90	(revision 2354)
@@ -0,0 +1,172 @@
+MODULE mod_domain
+   USE mod_xmlio_parameters
+   INTEGER, PARAMETER :: box=1
+   INTEGER, PARAMETER :: orange=2
+   
+  TYPE domain
+    INTEGER :: rank
+    INTEGER :: ni
+    INTEGER :: nj
+    INTEGER :: ibegin
+    INTEGER :: iend
+    INTEGER :: jbegin
+    INTEGER :: jend
+    REAL,POINTER :: lon(:,:)
+    REAL,POINTER :: lat(:,:)
+    
+    INTEGER         :: type
+    LOGICAL,POINTER :: mask(:)
+    INTEGER,POINTER :: i_index(:)
+    INTEGER,POINTER :: j_index(:)
+    INTEGER         :: nbp
+    LOGICAL         :: is_defined
+  END TYPE domain
+ 
+  INCLUDE 'vector_domain_def.inc'
+
+CONTAINS
+
+  INCLUDE 'vector_domain_contains.inc'
+
+  SUBROUTINE domain__new(Pt_domain)
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    
+    Pt_domain%is_defined=.FALSE.
+    
+  END SUBROUTINE domain__new
+  
+  SUBROUTINE domain__set(Pt_domain,rank,ni,nj,ibegin,jbegin,lon,lat)
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    INTEGER,INTENT(IN) :: rank
+    INTEGER,INTENT(IN) :: ni
+    INTEGER,INTENT(IN) :: nj
+    INTEGER,INTENT(IN) :: ibegin
+    INTEGER,INTENT(IN) :: jbegin
+    REAL,INTENT(IN)    :: lon(ni,nj)
+    REAL,INTENT(IN)    :: lat(ni,nj)
+
+    Pt_domain%rank=rank
+    Pt_domain%ni=ni
+    Pt_domain%nj=nj
+    Pt_domain%ibegin=ibegin
+    Pt_domain%jbegin=jbegin   
+    Pt_domain%iend=ibegin+ni-1
+    Pt_domain%jend=jbegin+nj-1
+    ALLOCATE(Pt_domain%lon(ni,nj))
+    ALLOCATE(Pt_domain%lat(ni,nj))
+    Pt_domain%lon(:,:)=lon(:,:)
+    Pt_domain%lat(:,:)=lat(:,:)
+    Pt_domain%is_defined=.TRUE.
+  END SUBROUTINE domain__set
+
+
+  SUBROUTINE domain__set_type_box(Pt_domain,mask)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(domain),POINTER  :: Pt_domain
+    LOGICAL,INTENT(IN),OPTIONAL :: mask(:,:)
+    INTEGER                     :: i,j
+  
+    Pt_domain%type=box
+    pt_domain%nbp=pt_domain%ni*pt_domain%nj
+    ALLOCATE(Pt_domain%i_index(pt_domain%nbp))
+    ALLOCATE(Pt_domain%j_index(pt_domain%nbp))
+    ALLOCATE(pt_domain%mask(pt_domain%nbp))
+
+    IF (PRESENT(mask)) THEN
+      IF ( size(mask,1)==pt_domain%ni .AND. size(mask,2)==pt_domain%nj) THEN
+        DO i=1,pt_domain%ni
+          DO j=1,pt_domain%nj
+            pt_domain%mask((j-1)*pt_domain%ni+i)=mask(i,j)
+          ENDDO
+        ENDDO
+      ELSE
+        WRITE (message,*) "mask dimensions are not compliant with domain dimensions :",   &
+                           size(mask,1),",",size(mask,2),"/=",Pt_domain%ni,",",Pt_domain%nj
+        CALL error("domain__set_type_box")
+      ENDIF
+    ELSE
+      pt_domain%mask(:)=.TRUE.
+    ENDIF
+    
+    DO i=1,pt_domain%ni
+      DO j=1,pt_domain%nj
+        pt_domain%i_index((j-1)*pt_domain%ni+i) = i
+        pt_domain%j_index((j-1)*pt_domain%ni+i) = j
+      ENDDO
+    ENDDO
+
+  END SUBROUTINE domain__set_type_box
+
+
+  SUBROUTINE domain__set_type_orange(Pt_domain,nbp,offset,opt_index)
+  IMPLICIT NONE
+    TYPE(domain),POINTER        :: Pt_domain
+    INTEGER,INTENT(IN)          :: nbp
+    INTEGER,INTENT(IN)          :: offset
+    INTEGER,INTENT(IN),OPTIONAL :: opt_index(:)
+    
+    INTEGER  :: index(nbp)
+    INTEGER  :: i
+    
+    Pt_domain%type=orange
+    
+    IF (PRESENT(opt_index)) THEN
+      index(:)=opt_index(:)       
+    ELSE
+      DO i=1,nbp
+        index(i)=i
+      ENDDO
+    ENDIF
+
+    pt_domain%nbp=nbp
+    ALLOCATE(pt_domain%i_index(nbp))
+    ALLOCATE(pt_domain%j_index(nbp))
+    ALLOCATE(pt_domain%mask(nbp))
+        
+    DO i=1,nbp
+!      Pt_domain%i_index(i)=(index(i)+offset)/pt_domain%ni+1+pt_domain%ibegin-1
+!      Pt_domain%j_index(i)=MOD(index(i)+offset,pt_domain%ni)+1+pt_domain%jbegin-1
+      Pt_domain%i_index(i)=MOD(index(i)+offset-1,pt_domain%ni)+1
+      Pt_domain%j_index(i)=(index(i)+offset-1)/pt_domain%ni+1
+      
+    ENDDO
+
+    Pt_domain%mask(:)=.TRUE.
+
+  END SUBROUTINE domain__set_type_orange
+
+
+    
+  SUBROUTINE domain__print(pt_domain)
+  IMPLICIT NONE
+    TYPE(domain),POINTER   :: Pt_domain
+
+    PRINT *,"---- DOMAIN ----"
+    
+    IF (pt_domain%is_defined) THEN
+      PRINT *,"rank :",pt_domain%rank
+      PRINT *,"ni :",pt_domain%ni
+      PRINT *,"nj :",pt_domain%nj
+      PRINT *,"ibegin",pt_domain%ibegin
+      PRINT *,"iend",pt_domain%iend
+    ELSE
+      PRINT *,"  ---> domain undefined"
+    ENDIF
+    
+    PRINT *,"-----------------"
+  END SUBROUTINE domain__print
+  
+  SUBROUTINE domain__copy(Pt_in,pt_out)
+  IMPLICIT NONE
+    TYPE(domain),POINTER   :: Pt_in
+    TYPE(domain),POINTER   :: Pt_out
+  
+    IF (pt_in%is_defined) THEN
+      CALL domain__set(pt_out,pt_in%rank,pt_in%ni,pt_in%nj,pt_in%ibegin,pt_in%jbegin,pt_in%lon,pt_in%lat)
+    ENDIF
+  END SUBROUTINE domain__copy
+  
+END MODULE mod_domain
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_error_msg.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_error_msg.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_error_msg.f90	(revision 2354)
@@ -0,0 +1,40 @@
+MODULE error_msg
+  USE mod_xmlio_parameters,ONLY : str_msg_len
+
+  CHARACTER(LEN=str_msg_len),SAVE :: message
+
+CONTAINS
+
+  SUBROUTINE Warning(sub_name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: sub_name
+    
+    IF (PRESENT(sub_name)) THEN
+      PRINT *,"--* WARNING *-- : in subroutine "//sub_name
+    ELSE
+      PRINT *,"--* WARNING *-- "
+    ENDIF
+    
+    PRINT *,"----> ",TRIM(message)
+    message=REPEAT(' ',str_msg_len)
+    
+  END SUBROUTINE warning
+  
+  SUBROUTINE error(sub_name)
+  IMPLICIT NONE
+    CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: sub_name
+    
+    IF (PRESENT(sub_name)) THEN
+      PRINT *,"--* WARNING *-- : in subroutine "//sub_name
+    ELSE
+      PRINT *,"--* WARNING *-- "
+    ENDIF
+
+    PRINT *,"----> ",TRIM(message)
+    message=REPEAT(' ',str_msg_len)
+    
+    STOP 
+  
+  END SUBROUTINE error    
+
+END MODULE error_msg
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field.f90	(revision 2354)
@@ -0,0 +1,658 @@
+MODULE mod_field
+
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_axis
+  USE mod_grid
+  USE mod_zoom
+   
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: field
+    CHARACTER(len=str_len)         :: id
+    LOGICAL                        :: has_id
+    CHARACTER(len=str_len)         :: name
+    LOGICAL                        :: has_name
+    CHARACTER(len=str_len)         :: description
+    LOGICAL                        :: has_description
+    CHARACTER(len=str_len)         :: unit
+    LOGICAL                        :: has_unit
+    CHARACTER(len=str_len)         :: operation
+    LOGICAL                        :: has_operation
+    INTEGER                        :: freq_op
+    LOGICAL                        :: has_freq_op
+    CHARACTER(len=str_len)         :: axis_ref
+    LOGICAL                        :: has_axis_ref
+    CHARACTER(len=str_len)         :: grid_ref
+    LOGICAL                        :: has_grid_ref
+    CHARACTER(len=str_len)         :: zoom_ref
+    LOGICAL                        :: has_zoom_ref
+    INTEGER                        :: level
+    LOGICAL                        :: has_level
+    INTEGER                        :: prec
+    LOGICAL                        :: has_prec
+    CHARACTER(len=str_len)         :: field_ref
+    LOGICAL                        :: has_field_ref
+    TYPE(field),POINTER            :: field_base
+    LOGICAL                        :: has_field_base
+    LOGICAL                        :: enabled
+    LOGICAL                        :: has_enabled
+    LOGICAL                        :: solved_field_ref
+    TYPE(axis), POINTER            :: axis
+    LOGICAL                        :: has_axis
+    TYPE(grid),POINTER             :: grid
+    LOGICAL                        :: has_grid
+    TYPE(zoom),POINTER             :: zoom
+    LOGICAL                        :: has_zoom
+    INTEGER                        :: internal(internal_field)
+    
+    
+  END TYPE field
+  
+  INTERFACE field__set_attribut
+    MODULE PROCEDURE field__set_attribut_id,field__set_attribut_pt
+  END INTERFACE
+  
+  INCLUDE 'vector_field_def.inc'
+  
+  TYPE(vector_field),POINTER,SAVE            :: field_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids
+  
+
+CONTAINS
+  INCLUDE 'vector_field_contains.inc'
+
+  SUBROUTINE field__swap_context(saved_field_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_field),POINTER :: saved_field_ids
+    TYPE(sorted_list),POINTER  :: saved_ids
+    
+    field_Ids=>saved_field_ids
+    Ids=>saved_Ids
+
+  END SUBROUTINE field__swap_context
+
+  SUBROUTINE field__init
+  IMPLICIT NONE
+    
+    CALL vector_field__new(field_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE field__init
+  
+  SUBROUTINE field__get(Id,Pt_field)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(field),POINTER             :: Pt_field
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_field=>field_ids%at(Pos)%Pt
+    ELSE
+      Pt_field=>NULL()
+    ENDIF
+    
+  END SUBROUTINE field__get
+    
+  
+  SUBROUTINE field__new(pt_field,Id)
+   USE string_function
+   IMPLICIT NONE
+   TYPE(field), POINTER          :: pt_field
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   
+   INTEGER              :: Pos
+
+   Pt_field%has_id=.FALSE.
+   pt_field%has_name = .FALSE.
+   pt_field%has_description = .FALSE.
+   pt_field%has_unit = .FALSE.
+   pt_field%has_operation = .FALSE.
+   pt_field%has_freq_op = .FALSE.
+   pt_field%has_axis_ref = .FALSE.
+   pt_field%has_grid_ref = .FALSE.
+   pt_field%has_zoom_ref = .FALSE.
+   pt_field%has_prec = .FALSE.
+   pt_field%has_level = .FALSE. 
+   pt_field%has_field_ref = .FALSE.
+   pt_field%has_field_base = .FALSE.
+   pt_field%has_enabled = .FALSE.
+   Pt_field%solved_field_ref=.FALSE.
+   Pt_field%has_axis=.FALSE.
+   Pt_field%has_grid=.FALSE.
+   Pt_field%has_zoom=.FALSE.
+      
+   IF (PRESENT(Id)) THEN
+     Pt_field%id=TRIM(ADJUSTL(Id))
+     Pt_field%has_id=.TRUE.
+     CALL vector_field__set_new(field_Ids,Pt_field,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+   
+ END SUBROUTINE field__new
+
+
+ SUBROUTINE field__set(p_field, name, ref, description, unit, operation, freq_op, axis_ref, grid_ref, zoom_ref, prec, level, &
+                       enabled)
+
+    TYPE(field), pointer :: p_field
+    CHARACTER(len=*), OPTIONAL :: name
+    CHARACTER(len=*), OPTIONAL :: ref
+    CHARACTER(len=*), OPTIONAL  :: description
+    CHARACTER(len=*), OPTIONAL  :: unit
+    CHARACTER(len=*), OPTIONAL :: operation
+    INTEGER, OPTIONAL  :: freq_op
+    CHARACTER(len=*),OPTIONAL :: axis_ref
+    CHARACTER(len=*),OPTIONAL :: grid_ref
+    CHARACTER(len=*),OPTIONAL :: zoom_ref
+    INTEGER, OPTIONAL :: prec
+    INTEGER, OPTIONAL :: level
+    LOGICAL, OPTIONAL :: enabled
+
+    IF (PRESENT(name)) THEN
+        p_field%name=TRIM(ADJUSTL(name))
+        p_field%has_name = .TRUE.
+    ENDIF
+    IF (PRESENT(ref)) THEN
+        p_field%field_ref=TRIM(ADJUSTL(ref))
+        p_field%has_field_ref = .TRUE.
+    ENDIF
+    IF (PRESENT(description)) THEN
+        p_field%description=TRIM(ADJUSTL(description))
+        p_field%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(unit)) then
+        p_field%unit=TRIM(ADJUSTL(unit))
+        p_field%has_unit = .TRUE.
+    ENDIF
+    IF (PRESENT(operation)) THEN
+        p_field%operation=TRIM(ADJUSTL(operation))
+        p_field%has_operation = .TRUE.
+    ENDIF
+    IF (PRESENT(freq_op)) THEN
+        p_field%freq_op=freq_op
+        p_field%has_freq_op = .TRUE.
+    ENDIF
+    IF (PRESENT(axis_ref)) THEN
+        p_field%axis_ref=TRIM(ADJUSTL(axis_ref))
+        p_field%has_axis_ref = .TRUE.
+    ENDIF
+    IF (PRESENT(grid_ref)) THEN
+        p_field%grid_ref=TRIM(ADJUSTL(grid_ref))
+        p_field%has_grid_ref = .TRUE.
+    ENDIF
+
+    IF (PRESENT(zoom_ref)) THEN
+        p_field%zoom_ref=TRIM(ADJUSTL(zoom_ref))
+        p_field%has_zoom_ref = .TRUE.
+    ENDIF
+
+    IF (PRESENT(prec)) then
+        p_field%prec=prec
+        p_field%has_prec = .TRUE.
+    ENDIF
+    
+    IF (PRESENT(level)) then
+        p_field%level=level
+        p_field%has_level = .TRUE.
+    ENDIF
+
+    IF (PRESENT(enabled)) then
+        p_field%enabled=enabled
+        p_field%has_enabled = .TRUE.
+    ENDIF
+
+  END SUBROUTINE field__set
+
+  SUBROUTINE field__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field),POINTER             :: Pt_field
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_field=>field_ids%at(Pos)%Pt
+      CALL field__set_attribut(Pt_field,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field id :',id,'is undefined'
+        CALL error('mod_field::field__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  END SUBROUTINE field__set_attribut_id
+
+    
+  SUBROUTINE field__set_attribut_pt(pt_field,attrib)
+  USE mod_attribut
+  USE mod_field_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field),POINTER             :: Pt_field
+    TYPE(attribut),INTENT(IN) :: attrib
+
+    SELECT CASE(attrib%name)
+      CASE (field__name)
+        IF (attrib%type==string0) CALL  field__set(pt_field,name=attrib%string0_ptr) ; RETURN
+      CASE (field__field_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,ref=attrib%string0_ptr) ; RETURN
+      CASE (field__description)
+        IF (attrib%type==string0) CALL  field__set(pt_field,description=attrib%string0_ptr) ; RETURN
+      CASE (field__unit)
+        IF (attrib%type==string0) CALL  field__set(pt_field,unit=attrib%string0_ptr) ; RETURN
+      CASE (field__operation)
+        IF (attrib%type==string0) CALL  field__set(pt_field,operation=attrib%string0_ptr) ; RETURN
+      CASE (field__freq_op)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,freq_op=attrib%integer0_ptr) ; RETURN
+      CASE (field__axis_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,axis_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__grid_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,grid_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__zoom_ref)
+        IF (attrib%type==string0) CALL  field__set(pt_field,zoom_ref=attrib%string0_ptr) ; RETURN
+      CASE (field__prec)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,prec=attrib%integer0_ptr) ; RETURN
+      CASE (field__level)
+        IF (attrib%type==integer0) CALL  field__set(pt_field,level=attrib%integer0_ptr) ; RETURN
+      CASE (field__enabled)
+        IF (attrib%type==logical0) CALL  field__set(pt_field,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'field attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_field::field__set_attribut')
+    
+  END SUBROUTINE field__set_attribut_pt    
+
+  SUBROUTINE field__print(pt_field)
+
+    TYPE(field), POINTER :: pt_field
+    
+    PRINT *,"--- FIELD ---"
+
+    IF (pt_field%has_id) THEN
+        PRINT *, 'id : ',TRIM(pt_field%id)
+    ELSE
+        PRINT *, 'id undefined '
+    ENDIF
+
+    IF (pt_field%has_name) THEN
+        PRINT *, 'name : ',TRIM(pt_field%name)
+    ELSE
+        PRINT *, 'name undefined '
+    ENDIF
+    IF (pt_field%has_description) THEN
+        PRINT *, 'description : ',TRIM(pt_field%description)
+    ELSE
+        PRINT *, 'description undefined '
+    ENDIF
+    IF (pt_field%has_unit) THEN
+        PRINT *, 'unit : ',TRIM(pt_field%unit)
+    ELSE
+        PRINT *, 'unit undefined '
+    ENDIF
+    IF (pt_field%has_operation) THEN
+        PRINT *, 'operation ',TRIM(pt_field%operation)
+    ELSE
+        PRINT *, 'operation undefined '
+    ENDIF
+    IF (pt_field%has_freq_op) THEN
+        PRINT *, 'freq_op ',pt_field%freq_op
+    ELSE
+        PRINT *, 'freq_op undefined '
+    ENDIF
+
+    IF (pt_field%has_axis_ref) THEN
+        PRINT *, 'axis_ref : ',TRIM(pt_field%axis_ref)
+    ELSE
+        PRINT *, 'axis_ref undefined '
+    ENDIF
+
+    IF (pt_field%has_grid_ref) THEN
+        PRINT *, 'grid_ref : ',TRIM(pt_field%grid_ref)
+    ELSE
+        PRINT *, 'grid_ref undefined '
+    ENDIF
+
+    IF (pt_field%has_zoom_ref) THEN
+        PRINT *, 'zoom_ref : ',TRIM(pt_field%zoom_ref)
+    ELSE
+        PRINT *, 'zoom_ref undefined '
+    ENDIF
+    
+    IF (pt_field%has_field_ref) THEN
+        PRINT *, 'field_ref : ',TRIM(pt_field%field_ref)
+    ELSE
+        PRINT *, 'field_ref undefined '
+    ENDIF
+
+!    call vert_axis__print(pt_field%p_vert_axis)
+!
+!    IF (pt_field%is_vert_axis_ref_def) THEN
+!        PRINT *, 'pt_field%vert_axis_ref ',TRIM(pt_field%vert_axis_ref)
+!    ELSE
+!        PRINT *, 'pt_field%vert_axis_ref undefined '
+!    ENDIF
+    IF (pt_field%has_prec) THEN
+        PRINT *, 'prec ',pt_field%prec
+    ELSE
+        PRINT *, 'prec undefined '
+    ENDIF
+    IF (pt_field%has_level) then
+        PRINT *, 'level ',pt_field%level
+    ELSE
+        PRINT *, 'level undefined '
+    ENDIF
+    IF (pt_field%has_field_base) THEN
+        PRINT *, 'field_base :',TRIM(Pt_field%field_base%id)
+    ELSE
+        PRINT *, 'field_base indefini'
+    ENDIF
+
+    IF (pt_field%has_enabled) THEN
+        PRINT *, 'enabled : ',pt_field%enabled
+    ELSE
+        PRINT *, 'enabled indefini'
+    ENDIF
+ 
+    PRINT *,"------------"
+    
+  END SUBROUTINE field__print
+
+!  SUBROUTINE field__resolve_ref_vert_axis(p_field)
+!
+!    TYPE(field), POINTER :: p_field
+!    CHARACTER(len=str_len) :: name
+!
+!    IF (p_field%is_vert_axis_ref_def) THEN
+!        name=p_field%vert_axis_ref
+!        IF (vert_axis_def__is_exist(name)) THEN
+!            CALL vert_axis_def__get(name,p_field%p_vert_axis)
+!            p_field%is_vert_axis_def = .TRUE.
+!        ENDIF
+!    ENDIF
+!
+!  END SUBROUTINE field__resolve_ref_vert_axis
+
+  SUBROUTINE field__apply_default(pt_field_default, pt_field_in, pt_field_out)
+
+    TYPE(field), POINTER :: pt_field_default, pt_field_in, pt_field_out
+
+    IF (pt_field_in%has_name) THEN
+        pt_field_out%name=pt_field_in%name
+        pt_field_out%has_name=.TRUE.
+    ELSE IF ( pt_field_default%has_name) THEN
+        pt_field_out%name=pt_field_default%name
+        pt_field_out%has_name=.TRUE.
+    ELSE
+        pt_field_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_field_in%has_description) THEN
+        pt_field_out%description=pt_field_in%description
+        pt_field_out%has_description=.TRUE.
+    ELSE IF ( pt_field_default%has_description ) THEN
+        pt_field_out%description=pt_field_default%description
+        pt_field_out%has_description=.TRUE.
+    ELSE
+        pt_field_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_unit) THEN
+        pt_field_out%unit=pt_field_in%unit
+        pt_field_out%has_unit=.TRUE.
+    ELSE IF ( pt_field_default%has_unit ) THEN
+        pt_field_out%unit=pt_field_default%unit
+        pt_field_out%has_unit=.TRUE.
+    ELSE
+        pt_field_out%has_unit=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_operation) THEN
+        pt_field_out%operation=pt_field_in%operation
+        pt_field_out%has_operation=.TRUE.
+    ELSE IF ( pt_field_default%has_operation ) THEN
+        pt_field_out%operation=pt_field_default%operation
+        pt_field_out%has_operation=.TRUE.
+    ELSE
+        pt_field_out%has_operation=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_freq_op) THEN
+        pt_field_out%freq_op=pt_field_in%freq_op
+        pt_field_out%has_freq_op=.TRUE.
+    ELSE IF ( pt_field_default%has_freq_op ) THEN
+        pt_field_out%freq_op=pt_field_default%freq_op
+        pt_field_out%has_freq_op=.TRUE.
+    ELSE
+        pt_field_out%has_freq_op=.FALSE.
+    ENDIF
+
+!    IF (pt_field_in%has_axis) THEN
+!        pt_field_out%p_axis => pt_field_in%p_axis
+!        pt_field_out%has_axis=.TRUE.
+!    ELSE IF ( pt_field_default%has_axis ) THEN
+!        pt_field_out%p_axis => pt_field_default%p_axis
+!        pt_field_out%has_axis=.TRUE.
+!    ELSE
+!        pt_field_out%has_axis=.FALSE.
+!    ENDIF
+    
+    IF (pt_field_in%has_axis_ref) THEN
+        pt_field_out%axis_ref=pt_field_in%axis_ref
+        pt_field_out%has_axis_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_axis_ref ) THEN
+        pt_field_out%axis_ref=pt_field_default%axis_ref
+        pt_field_out%has_axis_ref=.TRUE.
+    ELSE
+        pt_field_out%has_axis_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_grid_ref) THEN
+        pt_field_out%grid_ref=pt_field_in%grid_ref
+        pt_field_out%has_grid_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_grid_ref ) THEN
+        pt_field_out%grid_ref=pt_field_default%grid_ref
+        pt_field_out%has_grid_ref=.TRUE.
+    ELSE
+        pt_field_out%has_grid_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_zoom_ref) THEN
+        pt_field_out%zoom_ref=pt_field_in%zoom_ref
+        pt_field_out%has_zoom_ref=.TRUE.
+    ELSE IF ( pt_field_default%has_zoom_ref ) THEN
+        pt_field_out%zoom_ref=pt_field_default%zoom_ref
+        pt_field_out%has_zoom_ref=.TRUE.
+    ELSE
+        pt_field_out%has_zoom_ref=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_prec) THEN
+        pt_field_out%prec=pt_field_in%prec
+        pt_field_out%has_prec=.TRUE.
+    ELSE IF ( pt_field_default%has_prec ) THEN
+        pt_field_out%prec=pt_field_default%prec
+        pt_field_out%has_prec=.TRUE.
+    ELSE
+        pt_field_out%has_prec=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_level) THEN
+        pt_field_out%level=pt_field_in%level
+        pt_field_out%has_level=.TRUE.
+    ELSE IF ( pt_field_default%has_level ) THEN
+        pt_field_out%level=pt_field_default%level
+        pt_field_out%has_level=.TRUE.
+    ELSE
+        pt_field_out%has_level=.FALSE.
+    ENDIF
+
+    IF (pt_field_in%has_enabled) THEN
+        pt_field_out%enabled=pt_field_in%enabled
+        pt_field_out%has_enabled=.TRUE.
+    ELSE IF ( pt_field_default%has_enabled ) THEN
+        pt_field_out%enabled=pt_field_default%enabled
+        pt_field_out%has_enabled=.TRUE.
+    ELSE
+        pt_field_out%has_enabled=.FALSE.
+    ENDIF
+    
+  END SUBROUTINE field__apply_default
+
+!  FUNCTION field__is_vert_axis_attached(p_field, vert_axis_name)
+!
+!    LOGICAL :: field__is_vert_axis_attached
+!    TYPE(field), POINTER :: p_field
+!    CHARACTER(len=*), INTENT(IN) :: vert_axis_name
+!
+!    field__is_vert_axis_attached = .false.
+!    IF (p_field%is_vert_axis_def) THEN
+!        IF (vert_axis_name == p_field%p_vert_axis%name) field__is_vert_axis_attached = .TRUE.
+!    ENDIF
+!
+!  END FUNCTION field__is_vert_axis_attached
+
+  RECURSIVE SUBROUTINE field__solve_field_ref(pt_field)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(field), POINTER :: pt_field
+    
+    TYPE(field), POINTER :: field_ref
+    
+    IF (.NOT. pt_field%solved_field_ref) THEN
+      
+      IF (pt_field%has_field_ref) THEN
+      
+        CALL field__get(pt_field%field_ref,field_ref)
+      
+        IF (.NOT. ASSOCIATED(field_ref)) THEN
+          WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to field : id =",pt_field%field_ref
+          CALL error("field__solve_field_ref")
+        ENDIF
+      
+        CALL field__get_field_base(field_ref,pt_field%field_base) 
+        Pt_field%has_field_base=.TRUE.
+        
+        CALL field__apply_default(field_ref,pt_field,pt_field)
+        
+          
+      ELSE 
+
+        IF (pt_field%has_id) THEN
+          pt_field%field_base=>pt_field
+        ENDIF
+      
+      ENDIF
+      
+      IF (.NOT. pt_field%has_name) THEN
+        IF (pt_field%has_id) THEN
+          pt_field%name=pt_field%id
+          pt_field%has_name=.TRUE.
+        ENDIF
+      ENDIF
+    
+      Pt_field%solved_field_ref=.TRUE.
+    
+    ENDIF
+    
+  END SUBROUTINE field__solve_field_ref
+  
+
+  RECURSIVE SUBROUTINE field__get_field_base(pt_field,pt_field_base)
+  IMPLICIT NONE
+    TYPE(field), POINTER :: pt_field
+    TYPE(field), POINTER :: pt_field_base
+    
+     
+    IF (.NOT. Pt_field%solved_field_ref) THEN
+      CALL field__solve_field_ref(Pt_field)
+    ENDIF
+     
+    IF (pt_field%has_field_base) THEN
+      pt_field_base=>pt_field%field_base
+    ELSE
+      pt_field_base=>pt_field
+    ENDIF
+   
+ END SUBROUTINE field__get_field_base
+
+ SUBROUTINE field__solve_axis_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (pt_field%has_axis_ref) THEN
+     CALL axis__get(pt_field%axis_ref,pt_field%axis)
+     IF (ASSOCIATED(pt_field%axis)) THEN
+       pt_field%has_axis=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to axis : id =",pt_field%axis_ref
+       CALL error("mod_field::field__solve_axis_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_axis_ref
+   
+ SUBROUTINE field__solve_grid_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (pt_field%has_grid_ref) THEN
+     CALL grid__get(pt_field%grid_ref,pt_field%grid)
+     IF (ASSOCIATED(pt_field%grid)) THEN
+       pt_field%has_grid=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to grid : id =",pt_field%grid_ref
+       CALL error("mod_field::field__solve_grid_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_grid_ref
+   
+ SUBROUTINE field__solve_zoom_ref(pt_field)
+ USE error_msg
+ IMPLICIT NONE
+   TYPE(field), POINTER :: pt_field
+   
+   IF (.NOT. pt_field%has_zoom_ref) THEN
+     IF (pt_field%has_grid_ref) THEN
+       pt_field%has_zoom_ref=.TRUE.
+       pt_field%zoom_ref=pt_field%grid_ref
+     ENDIF
+   ENDIF
+    
+   IF (pt_field%has_zoom_ref) THEN
+     CALL zoom__get(pt_field%zoom_ref,pt_field%zoom)
+     IF (ASSOCIATED(pt_field%zoom)) THEN
+       pt_field%has_zoom=.TRUE.
+     ELSE
+       WRITE (message,*) "The field : id = ",pt_field%id,"  name = ",Pt_field%name,   &
+                        " has a unknown reference to zoom : id =",pt_field%zoom_ref
+       CALL error("mod_field::field__solve_zoom_ref")
+     ENDIF
+   ENDIF
+   
+ END SUBROUTINE field__solve_zoom_ref
+
+   
+END MODULE mod_field
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_attribute.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_attribute.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_attribute.f90	(revision 2354)
@@ -0,0 +1,21 @@
+MODULE mod_field_attribut
+  USE mod_object
+
+  INTEGER,PARAMETER :: field__begin = field_object + 10
+  
+  INTEGER,PARAMETER :: field__name = field_object + 11
+  INTEGER,PARAMETER :: field__description = field_object + 12
+  INTEGER,PARAMETER :: field__unit = field_object + 13
+  INTEGER,PARAMETER :: field__operation = field_object + 14
+  INTEGER,PARAMETER :: field__freq_op = field_object + 15
+  INTEGER,PARAMETER :: field__axis_ref = field_object + 16
+  INTEGER,PARAMETER :: field__grid_ref = field_object + 17
+  INTEGER,PARAMETER :: field__zoom_ref = field_object + 18
+  INTEGER,PARAMETER :: field__level = field_object + 19
+  INTEGER,PARAMETER :: field__prec = field_object + 20
+  INTEGER,PARAMETER :: field__field_ref = field_object + 21
+  INTEGER,PARAMETER :: field__enabled = field_object + 22
+
+  INTEGER,PARAMETER :: field__end = field_object + 23
+  
+END MODULE mod_field_attribut
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_definition.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_definition.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_definition.f90	(revision 2354)
@@ -0,0 +1,26 @@
+MODULE mod_field_definition
+  USE mod_field_group
+  
+  TYPE(field_group),SAVE,POINTER :: field_definition
+ 
+CONTAINS
+
+  SUBROUTINE field_definition__swap_context(saved_field_definition)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: saved_field_definition
+  
+    field_definition=>saved_field_definition
+
+  END SUBROUTINE field_definition__swap_context
+
+
+  SUBROUTINE field_definition__Init
+  IMPLICIT NONE
+  
+   CALL field_group__new(field_definition,"field_definition")
+
+  END SUBROUTINE field_definition__Init
+  
+        
+END MODULE mod_field_definition
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_field_group.f90	(revision 2354)
@@ -0,0 +1,304 @@
+MODULE mod_field_group
+
+  USE mod_field
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE field_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_field_group), POINTER         :: groups
+    TYPE(vector_field),POINTER                :: fields     
+    TYPE(field), POINTER                      :: default_attribut
+  END TYPE field_group
+
+  INCLUDE "vector_field_group_def.inc"  
+
+  TYPE(vector_field_group),SAVE,POINTER      :: field_group_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE field_group__set_attribut
+    MODULE PROCEDURE field_group__set_attribut_id,field_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_field_group_contains.inc"
+
+
+  SUBROUTINE field_group__swap_context(saved_field_group_ids, saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_field_group),POINTER   :: saved_field_group_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids
+    
+    field_group_ids=>saved_field_group_ids 
+    ids=>saved_ids
+    
+  END SUBROUTINE field_group__swap_context
+
+  SUBROUTINE field_group__init
+  IMPLICIT NONE
+    
+    CALL vector_field_group__new(field_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE field_group__init
+
+  SUBROUTINE field_group__get(Id,Pt_fg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(field_group),POINTER       :: Pt_fg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_fg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE field_group__get
+
+  SUBROUTINE field_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(field_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>field_group_ids%at(Pos)%Pt
+      CALL field_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'Field group id :',id,'is undefined'
+        CALL error('mod_field_group::field_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE field_group__set_attribut_id
+  
+  SUBROUTINE field_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(field_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==field_object) THEN
+      CALL field__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE field_group__set_attribut_pt
+    
+      
+  RECURSIVE SUBROUTINE field_group__new(Pt_fg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(field_group),POINTER                :: Pt_fg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_fg%groups)
+    ALLOCATE(Pt_fg%fields)
+    ALLOCATE(Pt_fg%default_attribut)
+    
+    CALL vector_field_group__new(Pt_fg%groups)
+    CALL vector_field__new(Pt_fg%fields)
+    CALL field__new(Pt_fg%default_attribut)
+    Pt_fg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_fg%id=TRIM(Id)
+      Pt_fg%has_id=.TRUE.
+      CALL vector_field_group__set_new(field_group_Ids,Pt_fg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE field_group__new
+
+      
+  SUBROUTINE field_group__get_new_group(Pt_fg,Pt_fg_out,Id)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER            :: Pt_fg
+    TYPE(field_group),POINTER            :: Pt_fg_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_field_group__get_new(Pt_fg%groups,Pt_fg_out)
+ 
+    IF (PRESENT(id)) THEN
+      CALL field_group__new(Pt_fg_out,Id)
+    ELSE
+      CALL field_group__new(Pt_fg_out)
+    ENDIF
+    
+  END SUBROUTINE field_group__get_new_group
+
+  
+  SUBROUTINE field_group__get_new_field(Pt_fg,Pt_f_out,Id)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER            :: Pt_fg
+    TYPE(field),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_field__get_new(Pt_fg%fields,Pt_f_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL field__new(Pt_f_out,Id)
+    ELSE
+      CALL field__new(Pt_f_out)
+    ENDIF
+    
+  END SUBROUTINE field_group__get_new_field
+  
+  
+  SUBROUTINE field_group__get_default_attrib(Pt_fg,Pt_f)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    TYPE(field),POINTER        :: Pt_f
+    
+    Pt_f=>Pt_fg%default_attribut
+  END SUBROUTINE field_group__get_default_attrib
+
+  
+  RECURSIVE SUBROUTINE field_group__apply_default(Pt_fg,default)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER           :: Pt_fg
+    TYPE(field),POINTER,OPTIONAL        :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL field__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__apply_default(Pt_fg%default_attribut,Pt_fg%fields%at(i)%pt,Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__apply_default
+  
+  SUBROUTINE field_group__solve_ref(pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+
+    CALL field_group__solve_field_ref(Pt_fg)
+    CALL field_group__solve_axis_ref(Pt_fg)
+    CALL field_group__solve_grid_ref(Pt_fg)
+    CALL field_group__solve_zoom_ref(Pt_fg)
+
+  END SUBROUTINE  field_group__solve_ref
+     
+  RECURSIVE SUBROUTINE field_group__solve_field_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_field_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_field_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_axis_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+    
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_axis_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_axis_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_axis_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_grid_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+     
+    INTEGER :: i
+ 
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_grid_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+       
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_grid_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_grid_ref
+
+  RECURSIVE SUBROUTINE field_group__solve_zoom_ref(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+     
+    INTEGER :: i
+ 
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__solve_zoom_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+       
+    DO i=1,Pt_fg%fields%size
+      CALL field__solve_zoom_ref(Pt_fg%fields%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE field_group__solve_zoom_ref
+  
+  RECURSIVE SUBROUTINE field_group__print(Pt_fg)
+  IMPLICIT NONE
+    TYPE(field_group),POINTER  :: Pt_fg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- FIELD GROUP ---"
+    IF (Pt_fg%has_id) THEN
+      PRINT *,"id :",TRIM(Pt_fg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"field default attribut :"
+    CALL field__print(Pt_fg%default_attribut)    
+
+    PRINT *,"owned field groups :",Pt_fg%groups%size      
+    DO i=1,Pt_fg%groups%size
+      CALL field_group__print(Pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned field :",Pt_fg%fields%size      
+    DO i=1,Pt_fg%fields%size
+      CALL field__print(Pt_fg%fields%at(i)%pt)
+    ENDDO
+    
+    PRINT *,"------------"
+    
+  END SUBROUTINE field_group__print     
+
+END MODULE mod_field_group
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file.f90	(revision 2354)
@@ -0,0 +1,362 @@
+MODULE mod_file
+
+  USE mod_xmlio_parameters
+  USE mod_field_group
+  USE mod_sorted_list
+
+  TYPE, PUBLIC :: file
+    CHARACTER(len=str_len)           :: id
+    LOGICAL                          :: has_id
+    CHARACTER(len=str_len)           :: name
+    LOGICAL                          :: has_name
+    CHARACTER(len=str_len)           :: name_suffix
+    LOGICAL                          :: has_name_suffix
+    CHARACTER(len=str_len)           :: description
+    LOGICAL                          :: has_description
+    INTEGER                          :: output_freq
+    LOGICAL                          :: has_output_freq
+    INTEGER                          :: output_level
+    LOGICAL                          :: has_output_level
+    LOGICAL                          :: enabled
+    LOGICAL                          :: has_enabled
+    INTEGER                          :: internal(internal_file)
+    TYPE(field_group),POINTER        :: field_list 
+  END TYPE file
+
+  INCLUDE 'vector_file_def.inc'
+  
+  TYPE(vector_file),POINTER,SAVE             :: file_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE file__set_attribut
+    MODULE PROCEDURE file__set_attribut_id,file__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_file_contains.inc'
+
+  SUBROUTINE file__swap_context(saved_file_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_file),POINTER      :: saved_file_Ids
+    TYPE(sorted_list),POINTER      :: saved_Ids
+    
+    file_ids=>saved_file_ids
+    ids=>saved_ids 
+ 
+  END SUBROUTINE file__swap_context
+
+
+  SUBROUTINE file__init
+  IMPLICIT NONE
+    
+    CALL vector_file__new(file_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE file__init
+  
+  SUBROUTINE file__get(Id,Pt_file)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(file),POINTER              :: Pt_file
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+    ELSE
+      Pt_file=>NULL()
+    ENDIF
+    
+  END SUBROUTINE file__get
+  
+  SUBROUTINE file__new(pt_file,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(file), POINTER           :: pt_file
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+
+   ALLOCATE(pt_file%field_list)
+   CALL field_group__new(pt_file%field_list)
+      
+   pt_file%has_id           = .FALSE.
+   pt_file%has_name         = .FALSE.
+   pt_file%has_name_suffix  = .FALSE.
+   pt_file%has_description  = .FALSE.
+   pt_file%has_output_freq  = .FALSE.
+   pt_file%has_output_level = .FALSE.
+   pt_file%has_enabled = .FALSE.
+   
+   IF (PRESENT(Id)) THEN
+     Pt_file%id=TRIM(ADJUSTL(Id))
+     Pt_file%has_id=.TRUE.
+     CALL vector_file__set_new(file_Ids,Pt_file,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+
+  END SUBROUTINE file__new
+
+  SUBROUTINE file__set(pt_file, name, name_suffix, description, output_freq, output_level,enabled)
+  IMPLICIT NONE
+    TYPE(file), POINTER         :: pt_file
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: name_suffix
+    CHARACTER(len=*)  ,OPTIONAL :: description
+    INTEGER           ,OPTIONAL :: output_freq
+    INTEGER           ,OPTIONAL :: output_level
+    LOGICAL           ,OPTIONAL :: enabled
+
+    IF (PRESENT(name)) THEN
+        pt_file%name=TRIM(ADJUSTL(name))
+        pt_file%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(name_suffix)) THEN
+        pt_file%name_suffix=TRIM(ADJUSTL(name_suffix))
+        pt_file%has_name_suffix = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_file%description=TRIM(ADJUSTL(description))
+        pt_file%has_description = .TRUE.
+    ENDIF
+ 
+    IF (PRESENT(output_freq)) then
+        pt_file%output_freq=output_freq
+        pt_file%has_output_freq = .TRUE.
+    ENDIF
+
+    IF (PRESENT(output_level)) then
+        pt_file%output_level = output_level
+        pt_file%has_output_level = .TRUE.
+    ENDIF
+
+    IF (PRESENT(enabled)) then
+        pt_file%enabled = enabled
+        pt_file%has_enabled = .TRUE.
+    ENDIF
+    
+  END SUBROUTINE file__set
+
+  SUBROUTINE file__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(file),POINTER              :: Pt_file
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_file=>file_ids%at(Pos)%Pt
+      CALL file__set_attribut_pt(Pt_file,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'File id : ',id,' is undefined'
+        CALL error('mod_file::file__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE file__set_attribut_id
+      
+  SUBROUTINE file__set_attribut_pt(Pt_file,attrib)
+  USE mod_attribut
+  USE mod_file_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(file),POINTER        :: Pt_file
+    TYPE(attribut),INTENT(IN) :: attrib
+
+    
+    SELECT CASE(attrib%name)
+      CASE (file__name)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__name_suffix)
+        IF (attrib%type==string0) CALL  file__set(pt_file,name_suffix=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__description)
+        IF (attrib%type==string0) CALL  file__set(pt_file,description=attrib%string0_ptr(1:attrib%string_len)) ; RETURN
+      CASE (file__output_freq)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_freq=attrib%integer0_ptr) ; RETURN
+      CASE (file__output_level)
+        IF (attrib%type==integer0) CALL  file__set(pt_file,output_level=attrib%integer0_ptr) ; RETURN
+      CASE (file__enabled)
+        IF (attrib%type==logical0) CALL  file__set(pt_file,enabled=attrib%logical0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'file attribut ',attrib%name,' : type : ',attrib%type,       &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_file::file__set_attribut')
+    
+  END SUBROUTINE file__set_attribut_pt
+  
+     
+  SUBROUTINE file__get_field_list(pt_file,pt_field_list)
+  IMPLICIT NONE
+    TYPE(file),POINTER         :: pt_file
+    TYPE(field_group),POINTER  :: pt_field_list
+    
+      pt_field_list=>pt_file%field_list
+  
+  END SUBROUTINE file__get_field_list
+    
+  SUBROUTINE file__print(pt_file)
+  IMPLICIT NONE
+    TYPE(file), POINTER         :: pt_file
+
+    PRINT *,"---- FILE ----"
+    IF (pt_file%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_file%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_file%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_file%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+
+    IF (pt_file%has_name_suffix) THEN
+      PRINT *,"name_suffix = ",TRIM(pt_file%name_suffix)
+    ELSE
+      PRINT *,"name_suffix undefined"
+    ENDIF
+    
+    IF (pt_file%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_file%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+ 
+    IF (pt_file%has_output_freq) THEN
+      PRINT *,"output_freq = ",pt_file%output_freq
+    ELSE
+      PRINT *,"output_freq undefined"
+    ENDIF
+
+    IF (pt_file%has_output_level) THEN
+      PRINT *,"output_level = ",pt_file%output_level
+    ELSE
+      PRINT *,"output_level undefined"
+    ENDIF
+
+    IF (pt_file%has_enabled) THEN
+      PRINT *,"enabled = ",pt_file%enabled
+    ELSE
+      PRINT *,"enabled undefined"
+    ENDIF
+
+    PRINT *,"field_list :"
+    CALL field_group__print(pt_file%field_list)
+
+    PRINT *,"--------------"
+
+  END SUBROUTINE file__print
+
+
+  SUBROUTINE file__apply_default(pt_file_default, pt_file_in, pt_file_out)
+
+    TYPE(file), POINTER :: pt_file_default, pt_file_in, pt_file_out
+
+    IF (pt_file_in%has_name) THEN
+        pt_file_out%name=pt_file_in%name
+        pt_file_out%has_name=.TRUE.
+    ELSE IF ( pt_file_default%has_name) THEN
+        pt_file_out%name=pt_file_default%name
+        pt_file_out%has_name=.TRUE.
+    ELSE
+        pt_file_out%has_name=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_in%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE IF ( pt_file_default%has_name_suffix) THEN
+        pt_file_out%name_suffix=pt_file_default%name_suffix
+        pt_file_out%has_name_suffix=.TRUE.
+    ELSE
+        pt_file_out%has_name_suffix=.FALSE.
+    ENDIF
+        
+    IF (pt_file_in%has_description) THEN
+        pt_file_out%description=pt_file_in%description
+        pt_file_out%has_description=.TRUE.
+    ELSE IF ( pt_file_default%has_description ) THEN
+        pt_file_out%description=pt_file_default%description
+        pt_file_out%has_description=.TRUE.
+    ELSE
+        pt_file_out%has_description=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_output_freq) THEN
+        pt_file_out%output_freq=pt_file_in%output_freq
+        pt_file_out%has_output_freq=.TRUE.
+    ELSE IF ( pt_file_default%has_output_freq ) THEN
+        pt_file_out%output_freq=pt_file_default%output_freq
+        pt_file_out%has_output_freq=.TRUE.
+    ELSE
+        pt_file_out%has_output_freq=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_output_level) THEN
+        pt_file_out%output_level=pt_file_in%output_level
+        pt_file_out%has_output_level=.TRUE.
+    ELSE IF ( pt_file_default%has_output_level ) THEN
+        pt_file_out%output_level=pt_file_default%output_level
+        pt_file_out%has_output_level=.TRUE.
+    ELSE
+        pt_file_out%has_output_level=.FALSE.
+    ENDIF
+
+    IF (pt_file_in%has_enabled) THEN
+        pt_file_out%enabled=pt_file_in%enabled
+        pt_file_out%has_enabled=.TRUE.
+    ELSE IF ( pt_file_default%has_enabled ) THEN
+        pt_file_out%enabled=pt_file_default%enabled
+        pt_file_out%has_enabled=.TRUE.
+    ELSE
+        pt_file_out%has_enabled=.FALSE.
+    ENDIF
+    
+    CALL field_group__apply_default(pt_file_out%field_list)
+
+
+  END SUBROUTINE file__apply_default
+
+   
+  SUBROUTINE file__solve_field_ref(pt_file)
+  IMPLICIT NONE
+    TYPE(file), POINTER :: pt_file
+    
+    CALL field_group__solve_ref(pt_file%field_list)
+  
+  END SUBROUTINE file__solve_field_ref
+  
+  
+  SUBROUTINE file__Check(pt_file)
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(file), POINTER :: pt_file
+      
+    IF (.NOT. pt_file%has_name) THEN
+      IF (pt_file%has_id) THEN
+        pt_file%name=TRIM(pt_file%id)
+      ELSE
+        WRITE(message,*) "File has no name and no id" 
+        CALL error("mod_file::file__check")
+      ENDIF 
+    ENDIF
+ 
+ END SUBROUTINE file__Check
+    
+END MODULE mod_file
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_attribut.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_attribut.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_attribut.f90	(revision 2354)
@@ -0,0 +1,16 @@
+MODULE mod_file_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: file__begin = file_object + 10
+    
+  INTEGER,PARAMETER :: file__name = file_object + 11
+  INTEGER,PARAMETER :: file__description = file_object + 12
+  INTEGER,PARAMETER :: file__output_freq = file_object + 13
+  INTEGER,PARAMETER :: file__output_level = file_object + 14
+  INTEGER,PARAMETER :: file__enabled = file_object + 15
+  INTEGER,PARAMETER :: file__name_suffix = file_object + 16
+
+  INTEGER,PARAMETER :: file__end = file_object + 17
+
+END MODULE mod_file_attribut
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_definition.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_definition.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_definition.f90	(revision 2354)
@@ -0,0 +1,24 @@
+MODULE mod_file_definition
+  USE mod_file_group
+  
+  TYPE(file_group),SAVE,POINTER :: file_definition
+  
+CONTAINS
+
+  SUBROUTINE file_definition__swap_context(saved_file_definition)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER      :: saved_file_definition
+     
+    file_definition=>saved_file_definition
+ 
+  END SUBROUTINE file_definition__swap_context
+
+  SUBROUTINE file_definition__Init
+  USE mod_file_group
+  IMPLICIT NONE
+  
+    CALL file_group__new(file_definition,"file_definition")
+    
+  END SUBROUTINE file_definition__Init
+        
+END MODULE mod_file_definition
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_file_group.f90	(revision 2354)
@@ -0,0 +1,259 @@
+MODULE mod_file_group
+  USE mod_file
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE file_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_file_group), POINTER          :: groups
+    TYPE(vector_file),POINTER                 :: files     
+    TYPE(file), POINTER                       :: default_attribut
+  END TYPE file_group
+
+  INCLUDE "vector_file_group_def.inc"  
+
+  TYPE(vector_file_group),POINTER,SAVE       :: file_group_Ids
+  TYPE(sorted_list),POINTER,PRIVATE,SAVE     :: Ids 
+
+  INTERFACE file_group__set_attribut
+    MODULE PROCEDURE file_group__set_attribut_id,file_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_file_group_contains.inc"
+
+  SUBROUTINE file_group__swap_context(saved_file_group_ids,saved_ids)
+  IMPLICIT NONE
+    TYPE(vector_file_group),POINTER      :: saved_file_group_Ids
+    TYPE(sorted_list),POINTER            :: saved_Ids
+    
+    file_group_ids=>saved_file_group_ids
+    ids=>saved_ids 
+ 
+  END SUBROUTINE file_group__swap_context
+
+  SUBROUTINE file_group__init
+  IMPLICIT NONE
+    
+    CALL vector_file_group__new(file_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE file_group__init
+
+  SUBROUTINE file_group__get(Id,Pt_fg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(file_group),POINTER        :: Pt_fg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_fg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE file_group__get
+
+  SUBROUTINE file_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(file_group),POINTER             :: Pt_fg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_fg=>file_group_ids%at(Pos)%Pt
+      CALL file_group__set_attribut(Pt_fg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'file group id :',id,' is undefined'
+        CALL error('mod_file_group::file_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE file_group__set_attribut_id
+  
+  SUBROUTINE file_group__set_attribut_pt(pt_fg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(file_group),POINTER :: Pt_fg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==file_object) THEN
+      CALL file__set_attribut(Pt_fg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE file_group__set_attribut_pt
+  
+      
+  RECURSIVE SUBROUTINE file_group__new(Pt_fg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(file_group),POINTER                :: Pt_fg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_fg%groups)
+    ALLOCATE(Pt_fg%files)
+    ALLOCATE(Pt_fg%default_attribut)
+    
+    CALL vector_file_group__new(Pt_fg%groups)
+    CALL vector_file__new(Pt_fg%files)
+    CALL file__new(Pt_fg%default_attribut)
+    Pt_fg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_fg%id=TRIM(Id)
+      Pt_fg%has_id=.TRUE.
+      CALL vector_file_group__set_new(file_group_Ids,Pt_fg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE file_group__new
+
+      
+  SUBROUTINE file_group__get_new_group(Pt_fg,Pt_fg_out,Id)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER             :: Pt_fg
+    TYPE(file_group),POINTER             :: Pt_fg_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_file_group__get_new(Pt_fg%groups,Pt_fg_out)
+    CALL file_group__new(Pt_fg_out)
+
+    IF (PRESENT(id)) THEN
+      CALL file_group__new(Pt_fg_out,Id)
+    ELSE
+      CALL file_group__new(Pt_fg_out)
+    ENDIF
+    
+  END SUBROUTINE file_group__get_new_group
+
+  
+  SUBROUTINE file_group__get_new_file(Pt_fg,Pt_f_out,Id)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER            :: Pt_fg
+    TYPE(file),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_file__get_new(Pt_fg%files,Pt_f_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL file__new(Pt_f_out,Id)
+    ELSE
+      CALL file__new(Pt_f_out)
+    ENDIF
+    
+  END SUBROUTINE file_group__get_new_file
+  
+  
+  SUBROUTINE file_group__get_default_attrib(Pt_fg,Pt_f)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+    TYPE(file),POINTER        :: Pt_f
+    
+    Pt_f=>Pt_fg%default_attribut
+  END SUBROUTINE file_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE file_group__apply_default(Pt_fg,default)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+    TYPE(file),POINTER,OPTIONAL        :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL file__apply_default(default,Pt_fg%default_attribut,Pt_fg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__apply_default(Pt_fg%groups%at(i)%pt,Pt_fg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      CALL file__apply_default(Pt_fg%default_attribut,Pt_fg%files%at(i)%pt,Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__apply_default
+
+  RECURSIVE SUBROUTINE file_group__solve_field_ref(pt_fg)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+
+    INTEGER :: i
+
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__solve_field_ref(Pt_fg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,Pt_fg%files%size
+      CALL file__solve_field_ref(Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__solve_field_ref
+  
+  
+  RECURSIVE SUBROUTINE file_group__print(Pt_fg)
+  IMPLICIT NONE
+    TYPE(file_group),POINTER  :: Pt_fg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- FILE GROUP ---"
+    IF (Pt_fg%has_id) THEN
+      PRINT *,"id :",TRIM(Pt_fg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"file default attribut :"
+    CALL file__print(Pt_fg%default_attribut)    
+
+    PRINT *,"owned file groups :"      
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__print(Pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned file :"      
+    DO i=1,Pt_fg%files%size
+      CALL file__print(Pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__print     
+
+  RECURSIVE SUBROUTINE file_group__Check(Pt_fg)
+  IMPLICIT NONE
+  
+    TYPE(file_group),POINTER  :: Pt_fg
+    INTEGER :: i
+   
+    DO i=1,Pt_fg%groups%size
+      CALL file_group__check(pt_fg%groups%at(i)%pt)
+    ENDDO
+
+    DO i=1,Pt_fg%files%size
+      CALL file__check(pt_fg%files%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE file_group__check     
+          
+END MODULE mod_file_group
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid.f90	(revision 2354)
@@ -0,0 +1,384 @@
+MODULE mod_grid
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+  USE mod_domain
+  USE mod_zoom
+
+  IMPLICIT NONE
+
+  TYPE, PUBLIC :: grid
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    TYPE(domain),POINTER        :: domain
+    TYPE(vector_domain),POINTER :: subdomain
+    TYPE(sorted_list),POINTER   :: rank_ids
+    INTEGER,POINTER             :: ranks(:)
+    INTEGER                     :: ni
+    INTEGER                     :: nj
+    LOGICAL                     :: has_dimension
+    TYPE(vector_zoom),POINTER   :: associated_zoom
+    TYPE(zoom),POINTER          :: global_zoom
+  END TYPE grid
+
+  INCLUDE 'vector_grid_def.inc'
+  
+  TYPE(vector_grid),POINTER,SAVE             :: grid_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE grid__set_attribut
+    MODULE PROCEDURE grid__set_attribut_id,grid__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+  INCLUDE 'vector_grid_contains.inc'
+
+  SUBROUTINE grid__swap_context(saved_grid_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_grid),POINTER          :: saved_grid_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    grid_ids=>saved_grid_ids
+    ids=>saved_ids
+  END SUBROUTINE grid__swap_context
+  
+  
+  SUBROUTINE grid__init
+  IMPLICIT NONE
+    
+    CALL vector_grid__new(grid_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE grid__init
+  
+  SUBROUTINE grid__get(Id,Pt_grid)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(grid),POINTER              :: Pt_grid
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_grid=>grid_ids%at(Pos)%Pt
+    ELSE
+      Pt_grid=>NULL()
+    ENDIF
+    
+  END SUBROUTINE grid__get
+  
+  SUBROUTINE grid__new(pt_grid,Id)
+  USE string_function
+  IMPLICIT NONE
+   TYPE(grid), POINTER           :: pt_grid
+   CHARACTER(LEN=*),OPTIONAL     :: Id
+   INTEGER                       :: Pos
+   
+   ALLOCATE(pt_grid%domain)
+   ALLOCATE(pt_grid%subdomain)
+   ALLOCATE(pt_grid%rank_ids)
+   ALLOCATE(pt_grid%associated_zoom)
+   
+   CALL domain__new(pt_grid%domain)
+   CALL vector_domain__new(pt_grid%subdomain)
+   CALL sorted_list__new(pt_grid%rank_ids)
+   CALL vector_zoom__new(pt_grid%associated_zoom)
+   
+   pt_grid%has_id          = .FALSE.
+   pt_grid%has_name        = .FALSE.
+   pt_grid%has_description = .FALSE.
+   pt_grid%has_dimension   = .FALSE.
+   
+   IF (PRESENT(Id)) THEN
+     Pt_grid%id=TRIM(ADJUSTL(Id))
+     Pt_grid%has_id=.TRUE.
+     CALL vector_grid__set_new(grid_Ids,Pt_grid,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+   ENDIF
+   
+   CALL grid__get_new_zoom(pt_grid,pt_grid%global_zoom,id)
+
+ END SUBROUTINE grid__new
+
+  SUBROUTINE grid__set(pt_grid, name, description)
+  IMPLICIT NONE
+    TYPE(grid), POINTER :: pt_grid
+    CHARACTER(len=*)  ,OPTIONAL :: name
+    CHARACTER(len=*)  ,OPTIONAL :: description
+
+    IF (PRESENT(name)) THEN
+        pt_grid%name=TRIM(ADJUSTL(name))
+        pt_grid%has_name = .TRUE.
+    ENDIF
+
+    IF (PRESENT(description)) THEN
+        pt_grid%description=TRIM(ADJUSTL(description))
+        pt_grid%has_description = .TRUE.
+    ENDIF
+
+  END SUBROUTINE grid__set
+
+
+  SUBROUTINE grid__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(grid),POINTER              :: Pt_grid
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_grid=>grid_ids%at(Pos)%Pt
+      CALL grid__set_attribut_pt(Pt_grid,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid id :',id,'is undefined'
+        CALL error('mod_grid::grid__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE grid__set_attribut_id
+      
+  SUBROUTINE grid__set_attribut_pt(Pt_grid,attrib)
+  USE mod_attribut
+  USE mod_grid_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(grid),POINTER        :: Pt_grid
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (grid__name)
+        IF (attrib%type==string0) CALL  grid__set(pt_grid,name=attrib%string0_ptr) ; RETURN
+      CASE (grid__description)
+        IF (attrib%type==string0) CALL  grid__set(pt_grid,description=attrib%string0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'grid attribut ',attrib%name,' : type :',attrib%type,      &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_grid::grid__set_attribut')
+    
+  END SUBROUTINE grid__set_attribut_pt
+  
+  SUBROUTINE grid__set_dimension(pt_grid, ni, nj)
+  IMPLICIT NONE
+    TYPE(grid), POINTER   :: pt_grid
+    INTEGER,INTENT(IN)    :: ni
+    INTEGER,INTENT(IN)    :: nj
+    
+    pt_grid%ni=ni
+    pt_grid%nj=nj
+    pt_grid%has_dimension=.TRUE.
+    
+  END SUBROUTINE grid__set_dimension
+    
+
+  SUBROUTINE grid__get_new_subdomain(Pt_grid,rank,pt_domain)
+  IMPLICIT NONE
+    TYPE(grid), POINTER   :: pt_grid
+    INTEGER,INTENT(IN)    :: rank
+    TYPE(domain), POINTER :: Pt_domain
+    
+    INTEGER :: Pos
+    
+    CALL vector_domain__get_new(pt_grid%subdomain,pt_domain,Pos)
+    CALL sorted_list__add(pt_grid%rank_ids,rank,Pos)
+    CALL domain__new(pt_domain)
+    
+  END SUBROUTINE grid__get_new_subdomain    
+
+  SUBROUTINE grid__get_subdomain(Pt_grid,rank,pt_domain)
+  IMPLICIT NONE
+    TYPE(grid), POINTER     :: pt_grid
+    INTEGER,INTENT(IN)      :: rank
+    TYPE(domain), POINTER   :: Pt_domain
+
+    INTEGER    :: rank_id
+    LOGICAL    :: success
+
+    CALL sorted_list__find(pt_grid%rank_ids,rank,rank_id,success)
+    IF (success) THEN
+      pt_domain=>pt_grid%subdomain%at(rank_id)%pt
+    ELSE
+      !! message d'erreur 
+   ENDIF
+
+  END SUBROUTINE grid__get_subdomain
+   
+  SUBROUTINE grid__process_domain(Pt_grid)
+  IMPLICIT NONE
+    TYPE(grid), POINTER  :: pt_grid
+    TYPE(domain),POINTER :: subdomain
+    TYPE(zoom),POINTER :: pt_zoom
+    
+    REAL,ALLOCATABLE :: lon(:,:)
+    REAL,ALLOCATABLE :: lat(:,:)
+    INTEGER :: ib,ie,jb,je,ni,nj,ibegin,jbegin,iend,jend
+    INTEGER :: i
+    
+      ALLOCATE(pt_grid%ranks(1:pt_grid%subdomain%size))
+
+      DO i=1,pt_grid%subdomain%size
+        subdomain=>pt_grid%subdomain%at(i)%pt
+        IF (i==1) THEN
+          ib=subdomain%ibegin
+          ie=subdomain%iend   
+          jb=subdomain%jbegin
+          je=subdomain%jend
+        ELSE
+          IF (subdomain%ibegin<ib) ib=subdomain%ibegin
+          IF (subdomain%iend>ie) ie=subdomain%iend
+          IF (subdomain%jbegin<jb) jb=subdomain%jbegin
+          IF (subdomain%jend>je) je=subdomain%jend
+        ENDIF
+        pt_grid%ranks(subdomain%rank)=i
+      ENDDO
+      
+      ni=ie-ib+1
+      nj=je-jb+1
+      ibegin=ib
+      jbegin=jb
+      
+      ALLOCATE(lon(ni,nj))
+      ALLOCATE(lat(ni,nj))
+      
+      DO i=1,pt_grid%subdomain%size
+        subdomain=>pt_grid%subdomain%at(i)%pt
+        ib=subdomain%ibegin-ibegin+1
+        ie=subdomain%iend-ibegin+1   
+        jb=subdomain%jbegin-jbegin+1
+        je=subdomain%jend-jbegin+1
+        lon(ib:ie,jb:je)=subdomain%lon(:,:)
+        lat(ib:ie,jb:je)=subdomain%lat(:,:)
+      ENDDO
+      
+      CALL domain__set(pt_grid%domain,0,ni,nj,ibegin,jbegin,lon,lat)
+      iend=ibegin+ni-1
+      jend=jbegin+nj-1
+      
+      
+      pt_grid%global_zoom%ni_glo=pt_grid%ni
+      pt_grid%global_zoom%nj_glo=pt_grid%nj
+      pt_grid%global_zoom%ibegin_glo=1      
+      pt_grid%global_zoom%jbegin_glo=1
+      
+      DO i=1,pt_grid%associated_zoom%size
+        pt_zoom=>pt_grid%associated_zoom%at(i)%pt
+        
+        ib=MAX(pt_zoom%ibegin_glo-ibegin+1,1)
+        ie=MIN(pt_zoom%ibegin_glo+pt_zoom%ni_glo-ibegin,ni)
+        pt_zoom%ni_loc=MAX(ie-ib+1,0)
+        pt_zoom%ibegin_loc=ib
+
+        jb=MAX(pt_zoom%jbegin_glo-jbegin+1,1)
+        je=MIN(pt_zoom%jbegin_glo+pt_zoom%nj_glo-jbegin,nj)
+        pt_zoom%nj_loc=MAX(je-jb+1,0)
+        pt_zoom%jbegin_loc=jb
+      ENDDO
+                 
+            
+      DEALLOCATE(lon)
+      DEALLOCATE(lat)
+      
+    END SUBROUTINE grid__process_domain
+      
+            
+  SUBROUTINE grid__get_new_zoom(pt_grid,pt_zoom,zoom_id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(grid), POINTER                      :: pt_grid
+    TYPE(zoom),POINTER                       :: pt_zoom
+    CHARACTER(LEN=*),INTENT(IN),OPTIONAL     :: zoom_id
+    LOGICAL                                  :: success
+    
+     CALL vector_zoom__get_new(pt_grid%associated_zoom,Pt_zoom)
+     CALL zoom__new(Pt_zoom,zoom_id)
+    
+   END SUBROUTINE grid__get_new_zoom
+     
+  SUBROUTINE grid__print(pt_grid)
+  IMPLICIT NONE
+    TYPE(grid), POINTER  :: pt_grid
+    INTEGER              :: i
+    
+    PRINT *,"---- GRID ----"
+    
+    IF (pt_grid%has_id) THEN
+      PRINT *,"id = ",TRIM(pt_grid%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    IF (pt_grid%has_name) THEN
+      PRINT *,"name = ",TRIM(pt_grid%name)
+    ELSE
+      PRINT *,"name undefined"
+    ENDIF
+    
+    IF (pt_grid%has_description) THEN
+      PRINT *,"description = ",TRIM(pt_grid%description)
+    ELSE
+      PRINT *,"description undefined"
+    ENDIF
+    
+    IF (pt_grid%has_dimension) THEN
+      PRINT *,"Global grid dimension :"
+      PRINT *,"   ni =",pt_grid%ni
+      PRINT *,"   nj =",pt_grid%nj
+    ELSE
+      PRINT *,"Global dimension ni, nj undefined"
+    ENDIF
+    
+    PRINT *,"grid domain :"
+    CALL domain__print(pt_grid%domain)
+    
+    PRINT *,"grid subdomain :",pt_grid%subdomain%size
+    
+    DO i=1,pt_grid%subdomain%size
+      CALL domain__print(pt_grid%subdomain%at(i)%pt)
+    ENDDO
+    
+    PRINT *,"--------------"
+    
+  END SUBROUTINE grid__print
+
+  SUBROUTINE grid__apply_default(pt_grid_default, pt_grid_in, pt_grid_out)
+
+    TYPE(grid), POINTER :: pt_grid_default, pt_grid_in, pt_grid_out
+
+    IF (pt_grid_in%has_name) THEN
+        pt_grid_out%name=pt_grid_in%name
+        pt_grid_out%has_name=.TRUE.
+    ELSE IF ( pt_grid_default%has_name) THEN
+        pt_grid_out%name=pt_grid_default%name
+        pt_grid_out%has_name=.TRUE.
+    ELSE
+        pt_grid_out%has_name=.FALSE.
+    ENDIF
+        
+    IF (pt_grid_in%has_description) THEN
+        pt_grid_out%description=pt_grid_in%description
+        pt_grid_out%has_description=.TRUE.
+    ELSE IF ( pt_grid_default%has_description ) THEN
+        pt_grid_out%description=pt_grid_default%description
+        pt_grid_out%has_description=.TRUE.
+    ELSE
+        pt_grid_out%has_description=.FALSE.
+    ENDIF
+  
+  END SUBROUTINE grid__apply_default
+
+END MODULE mod_grid
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_attribut.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_attribut.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_attribut.f90	(revision 2354)
@@ -0,0 +1,13 @@
+MODULE mod_grid_attribut
+  USE mod_object
+  
+  INTEGER,PARAMETER :: grid__begin = grid_object + 10
+
+  INTEGER,PARAMETER :: grid__name = grid_object + 11
+  INTEGER,PARAMETER :: grid__description = grid_object + 12
+
+  INTEGER,PARAMETER :: grid__end = grid_object + 13
+
+  
+END MODULE mod_grid_attribut
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_definition.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_definition.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_definition.f90	(revision 2354)
@@ -0,0 +1,24 @@
+MODULE mod_grid_definition
+  USE mod_grid_group
+  
+  TYPE(grid_group),SAVE,POINTER :: grid_definition
+  
+CONTAINS
+
+  SUBROUTINE grid_definition__swap_context(saved_grid_definition)      
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: saved_grid_definition
+    
+    grid_definition=>saved_grid_definition
+    
+  END SUBROUTINE grid_definition__swap_context 
+
+  SUBROUTINE grid_definition__Init
+  USE mod_grid_group
+  IMPLICIT NONE
+  
+    CALL grid_group__new(grid_definition,"grid_definition")
+    
+  END SUBROUTINE grid_definition__Init
+ 
+END MODULE mod_grid_definition
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_grid_group.f90	(revision 2354)
@@ -0,0 +1,244 @@
+MODULE mod_grid_group
+  USE mod_grid
+  USE mod_xmlio_parameters
+
+  IMPLICIT NONE
+
+  TYPE grid_group
+    CHARACTER(LEN=str_len)                    :: id
+    LOGICAL                                   :: has_id
+    TYPE(vector_grid_group), POINTER          :: groups
+    TYPE(vector_grid),POINTER                 :: grids     
+    TYPE(grid), POINTER                       :: default_attribut
+  END TYPE grid_group
+
+  INCLUDE "vector_grid_group_def.inc"  
+
+  TYPE(vector_grid_group),POINTER,SAVE       :: grid_group_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE grid_group__set_attribut
+    MODULE PROCEDURE grid_group__set_attribut_id,grid_group__set_attribut_pt
+  END INTERFACE
+
+CONTAINS
+
+  INCLUDE "vector_grid_group_contains.inc"
+
+  SUBROUTINE grid_group__swap_context(saved_grid_group_Ids,saved_ids)
+  IMPLICIT NONE
+  TYPE(vector_grid_group),POINTER       :: saved_grid_group_Ids
+  TYPE(sorted_list),POINTER             :: saved_Ids 
+   
+   grid_group_ids=>saved_grid_group_ids
+   ids=>saved_ids
+   
+  END SUBROUTINE grid_group__swap_context
+   
+  SUBROUTINE grid_group__init
+  IMPLICIT NONE
+    
+    CALL vector_grid_group__new(grid_group_Ids)
+    CALL sorted_list__new(Ids)
+   
+  END SUBROUTINE grid_group__init
+
+  SUBROUTINE grid_group__get(Id,Pt_gg)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(grid_group),POINTER        :: Pt_gg
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+    ELSE
+      Pt_gg=>NULL()
+    ENDIF
+    
+  END SUBROUTINE grid_group__get
+
+
+  SUBROUTINE grid_group__set_attribut_id(id,attrib,Ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: id
+    TYPE(attribut),INTENT(IN) :: attrib
+    LOGICAL,OPTIONAL,INTENT(out)  :: Ok
+    
+    TYPE(grid_group),POINTER             :: Pt_gg
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_gg=>grid_group_ids%at(Pos)%Pt
+      CALL grid_group__set_attribut(Pt_gg,attrib)
+      IF (PRESENT(OK)) ok=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'grid group id :',id,'is undefined'
+        CALL error('mod_grid_group::grid_group__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF 
+    
+  END SUBROUTINE grid_group__set_attribut_id
+  
+  SUBROUTINE grid_group__set_attribut_pt(pt_gg,attrib)
+  USE mod_attribut
+  USE mod_object
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER :: Pt_gg
+    TYPE(attribut),INTENT(IN) :: attrib
+     
+    IF (attrib%object==grid_object) THEN
+      CALL grid__set_attribut(pt_gg%default_attribut,attrib)
+    ENDIF
+    
+  END SUBROUTINE grid_group__set_attribut_pt    
+
+
+
+  RECURSIVE SUBROUTINE grid_group__new(Pt_gg,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER                :: Pt_gg
+    CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: Id
+    
+    INTEGER :: Pos
+    
+    ALLOCATE(Pt_gg%groups)
+    ALLOCATE(Pt_gg%grids)
+    ALLOCATE(Pt_gg%default_attribut)
+    
+    CALL vector_grid_group__new(Pt_gg%groups)
+    CALL vector_grid__new(Pt_gg%grids)
+    CALL grid__new(Pt_gg%default_attribut)
+    Pt_gg%has_id=.FALSE.
+      
+    IF (PRESENT(Id)) THEN
+      Pt_gg%id=TRIM(Id)
+      Pt_gg%has_id=.TRUE.
+      CALL vector_grid_group__set_new(grid_group_Ids,Pt_gg,Pos)
+      CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+
+  END SUBROUTINE grid_group__new
+
+      
+  SUBROUTINE grid_group__get_new_group(Pt_gg,Pt_gg_out,Id)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER             :: Pt_gg
+    TYPE(grid_group),POINTER             :: Pt_gg_out
+    CHARACTER(LEN=*),OPTIONAL            :: Id
+    
+    CALL vector_grid_group__get_new(Pt_gg%groups,Pt_gg_out)
+    CALL grid_group__new(Pt_gg_out)
+
+    IF (PRESENT(id)) THEN
+      CALL grid_group__new(Pt_gg_out,Id)
+    ELSE
+      CALL grid_group__new(Pt_gg_out)
+    ENDIF
+    
+  END SUBROUTINE grid_group__get_new_group
+
+  
+  SUBROUTINE grid_group__get_new_grid(Pt_gg,Pt_g_out,Id)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER            :: Pt_gg
+    TYPE(grid),POINTER                  :: Pt_g_out
+    CHARACTER(LEN=*),OPTIONAL      :: Id
+    
+    CALL vector_grid__get_new(Pt_gg%grids,Pt_g_out)
+    
+    IF (PRESENT(id)) THEN
+      CALL grid__new(Pt_g_out,Id)
+    ELSE
+      CALL grid__new(Pt_g_out)
+    ENDIF
+    
+  END SUBROUTINE grid_group__get_new_grid
+  
+  
+  SUBROUTINE grid_group__get_default_attrib(Pt_gg,Pt_g)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER  :: Pt_gg
+    TYPE(grid),POINTER        :: Pt_g
+    
+    Pt_g=>Pt_gg%default_attribut
+  END SUBROUTINE grid_group__get_default_attrib
+  
+  RECURSIVE SUBROUTINE grid_group__apply_default(Pt_gg,default)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER      :: Pt_gg
+    TYPE(grid),POINTER,OPTIONAL   :: default
+    
+    INTEGER :: i
+    
+    IF (PRESENT(default)) THEN
+      CALL grid__apply_default(default,Pt_gg%default_attribut,Pt_gg%default_attribut)
+    ENDIF
+      
+    DO i=1,Pt_gg%groups%size
+      CALL grid_group__apply_default(Pt_gg%groups%at(i)%pt,Pt_gg%default_attribut)
+    ENDDO
+    
+    DO i=1,Pt_gg%grids%size
+      CALL grid__apply_default(Pt_gg%default_attribut,Pt_gg%grids%at(i)%pt,Pt_gg%grids%at(i)%pt)
+    ENDDO
+  
+  END SUBROUTINE grid_group__apply_default
+
+  RECURSIVE SUBROUTINE grid_group__Process_domain(Pt_gg)
+  IMPLICIT NONE
+  TYPE(grid_group),POINTER  :: Pt_gg
+    INTEGER :: i
+    
+    DO i=1,pt_gg%groups%size
+      CALL grid_group__process_domain(pt_gg%groups%at(i)%pt)
+    ENDDO
+    
+    DO i=1,pt_gg%grids%size
+      CALL grid__process_domain(pt_gg%grids%at(i)%pt)
+    ENDDO
+    
+  END SUBROUTINE grid_group__Process_domain
+      
+
+  RECURSIVE SUBROUTINE grid_group__print(Pt_gg)
+  IMPLICIT NONE
+    TYPE(grid_group),POINTER  :: Pt_gg
+   
+    INTEGER :: i
+    
+    PRINT *,"--- GRID GROUP ---"
+    IF (pt_gg%has_id) THEN
+      PRINT *,"id  ",TRIM(pt_gg%id)
+    ELSE
+      PRINT *,"id undefined"
+    ENDIF
+    
+    PRINT *,"grid default attribut :"
+    CALL grid__print(Pt_gg%default_attribut)    
+
+    PRINT *,"owned grid groups : ",Pt_gg%groups%size      
+    DO i=1,Pt_gg%groups%size
+      CALL grid_group__print(Pt_gg%groups%at(i)%pt)
+    ENDDO
+
+    PRINT *,"owned grid : ",Pt_gg%grids%size     
+    DO i=1,Pt_gg%grids%size
+      CALL grid__print(Pt_gg%grids%at(i)%pt)
+    ENDDO
+    PRINT *,"------------"
+  
+  END SUBROUTINE grid_group__print
+     
+END MODULE mod_grid_group
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_object.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_object.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_object.f90	(revision 2354)
@@ -0,0 +1,14 @@
+MODULE mod_object
+
+  INTEGER,PARAMETER :: field_object=100
+  INTEGER,PARAMETER :: field_group_object=200
+  INTEGER,PARAMETER :: file_object=300
+  INTEGER,PARAMETER :: file_group_object=400
+  INTEGER,PARAMETER :: axis_object=500
+  INTEGER,PARAMETER :: axis_group_object=600
+  INTEGER,PARAMETER :: grid_object=700
+  INTEGER,PARAMETER :: grid_group_object=800
+  INTEGER,PARAMETER :: zoom_object=900
+  INTEGER,PARAMETER :: zoom_group_object=1000
+  
+END MODULE mod_object
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_parse_xml.f90	(revision 2354)
@@ -0,0 +1,810 @@
+MODULE parsing_xml
+  USE flib_dom
+  USE error_msg
+  USE string_function
+  
+CONTAINS
+
+  SUBROUTINE parsing_xml_file(name)
+  IMPLICIT NONE
+    CHARACTER(len=*), INTENT(IN) :: name
+    TYPE(fnode), POINTER :: myDoc
+
+    myDoc => parsefile(name)
+    CALL parsing_root(myDoc)
+
+    PRINT *, 'Le parsing est termine !!! '
+  
+  END SUBROUTINE parsing_xml_file
+  
+ 
+  SUBROUTINE parsing_root(root)
+  IMPLICIT NONE
+    TYPE(fnode), POINTER :: root
+    TYPE(fnode), POINTER :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+     
+    IF (hasChildNodes(root)) THEN
+      child_list => getChildnodes(root)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+          
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('simulation') 
+             CALL parsing_simulation(child_node)
+
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing root'
+               CALL Warning("mod_parse_xml:parsing_root")
+             ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+             
+  END SUBROUTINE parsing_root
+
+  SUBROUTINE parsing_simulation(root)
+  IMPLICIT NONE
+    TYPE(fnode), POINTER :: root
+    TYPE(fnode), POINTER :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+     
+     IF (hasChildNodes(root)) THEN
+      child_list => getChildnodes(root)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+          
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('context') 
+             CALL parsing_context(child_node)
+
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing simulation'
+               CALL Warning("mod_parse_xml:parsing_simulationt")
+             ENDIF
+         END SELECT
+       
+       ENDDO
+    ENDIF
+             
+  END SUBROUTINE parsing_simulation
+
+  SUBROUTINE parsing_context(node)
+  USE mod_context
+  USE mod_axis_definition
+  USE mod_grid_definition
+  USE mod_field_definition
+  USE mod_file_definition
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER         :: node
+    
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(axis),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL context__create(TRIM(value))  
+      CALL context__swap(TRIM(value))
+    ENDIF
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+          
+           CASE ('axis_definition') 
+             CALL parsing_axis_group(child_node,axis_definition,root=.TRUE.)
+               
+           CASE ('grid_definition')
+             CALL parsing_grid_group(child_node,grid_definition,root=.TRUE.)
+               
+           CASE ('field_definition')
+             CALL parsing_field_group(child_node,field_definition,root=.TRUE.)
+               
+           CASE ('file_definition')
+             CALL parsing_file_group(child_node,file_definition,root=.TRUE.)
+               
+           CASE DEFAULT
+             IF (is_bad_node(node_name)) THEN
+               WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing context'
+               CALL Warning("mod_parse_xml:parsing_context")
+             ENDIF   
+        END SELECT
+      ENDDO
+
+    ENDIF
+
+  END SUBROUTINE parsing_context
+
+
+  RECURSIVE SUBROUTINE parsing_axis_group(node,parent,root)
+  USE mod_axis_definition
+  USE mod_axis_group
+  USE mod_axis
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER         :: node
+    TYPE(axis_group),POINTER     :: parent
+    LOGICAL,INTENT(IN),OPTIONAL :: root
+    
+    TYPE(axis_group),POINTER :: pt_axis_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(axis),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_axis_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL axis_group__get_new_group(parent,pt_axis_group,TRIM(value))
+      ELSE
+        CALL axis_group__get_new_group(parent,pt_axis_group)
+      ENDIF
+    ENDIF
+      
+    CALL axis_group__get_default_attrib(pt_axis_group,attribute)
+    CALL parsing_axis_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_axis_group(child_node,pt_axis_group)
+             
+          CASE ('axis')
+            CALL parsing_axis(child_node,pt_axis_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_axis'
+              CALL Warning("mod_parse_xml:parsing_group_axis")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_axis_group
+
+  SUBROUTINE parsing_axis(node,parent)
+  USE mod_axis_group
+  USE mod_axis
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(axis_group),POINTER :: parent
+    
+    TYPE(axis),POINTER :: pt_axis
+    TYPE(axis),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL axis_group__get_new_axis(parent,pt_axis,TRIM(value))
+    ELSE
+      CALL axis_group__get_new_axis(parent,pt_axis)
+    ENDIF
+      
+    CALL parsing_axis_attribute(node,pt_axis)
+  
+  END SUBROUTINE parsing_axis
+
+  
+  SUBROUTINE parsing_axis_attribute(node,pt_axis)
+  USE mod_axis
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(axis),POINTER :: pt_axis
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL axis__set(pt_axis,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL axis__set(pt_axis,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"unit")) THEN
+      value =  getAttribute(node,"unit")
+      CALL axis__set(pt_axis,unit=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"size")) THEN
+      value =  getAttribute(node,"size")
+      CALL axis__set(pt_axis,a_size=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"positive")) THEN
+      value =  getAttribute(node,"positive")
+      CALL axis__set(pt_axis,positive=string_to_logical(value))
+    ENDIF
+   
+  END SUBROUTINE parsing_axis_attribute 
+
+
+
+
+
+
+
+
+  RECURSIVE SUBROUTINE parsing_grid_group(node,parent,root)
+  USE mod_grid_definition
+  USE mod_grid_group
+  USE mod_grid
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid_group),POINTER :: parent
+    LOGICAL,INTENT(IN),OPTIONAL :: root
+
+    TYPE(grid_group),POINTER :: pt_grid_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(grid),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_grid_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL grid_group__get_new_group(parent,pt_grid_group,TRIM(value))
+      ELSE
+        CALL grid_group__get_new_group(parent,pt_grid_group)
+      ENDIF
+    ENDIF
+      
+    CALL grid_group__get_default_attrib(pt_grid_group,attribute)
+    CALL parsing_grid_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_grid_group(child_node,pt_grid_group)
+             
+          CASE ('grid')
+            CALL parsing_grid(child_node,pt_grid_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_grid'
+              CALL Warning("mod_parse_xml:parsing_group_grid")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_grid_group
+
+  SUBROUTINE parsing_grid(node,parent)
+  USE mod_grid_group
+  USE mod_grid
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid_group),POINTER :: parent
+    
+    TYPE(grid),POINTER       :: pt_grid
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL grid_group__get_new_grid(parent,pt_grid,TRIM(value))
+    ELSE
+      CALL grid_group__get_new_grid(parent,pt_grid)
+    ENDIF
+      
+    CALL parsing_grid_attribute(node,pt_grid)
+    
+
+   IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('zoom') 
+            CALL parsing_zoom(child_node,pt_grid)
+             
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing grid'
+              CALL Warning("mod_parse_xml:parsing_grid")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+  
+  END SUBROUTINE parsing_grid
+
+  SUBROUTINE parsing_grid_attribute(node,pt_grid)
+  USE mod_grid
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid),POINTER :: pt_grid
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL grid__set(pt_grid,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL grid__set(pt_grid,description=TRIM(value))
+    ENDIF
+        
+  END SUBROUTINE parsing_grid_attribute 
+
+  SUBROUTINE parsing_zoom(node,parent)
+  USE mod_zoom
+  USE mod_grid 
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(grid),POINTER       :: parent
+    
+    TYPE(zoom),POINTER       :: pt_zoom
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL grid__get_new_zoom(parent,pt_zoom,TRIM(value))
+    ELSE
+      CALL grid__get_new_zoom(parent,pt_zoom)
+    ENDIF
+      
+    CALL parsing_zoom_attribute(node,pt_zoom)
+    
+  END SUBROUTINE parsing_zoom
+
+
+  SUBROUTINE parsing_zoom_attribute(node,pt_zoom)
+  USE mod_zoom
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(zoom),POINTER       :: pt_zoom
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL zoom__set(pt_zoom,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL zoom__set(pt_zoom,description=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ni")) THEN
+      value =  getAttribute(node,"ni")
+      CALL zoom__set(pt_zoom,ni_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"nj")) THEN
+      value =  getAttribute(node,"nj")
+      CALL zoom__set(pt_zoom,nj_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ibegin")) THEN
+      value =  getAttribute(node,"ibegin")
+      CALL zoom__set(pt_zoom,ibegin_glo=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"jbegin")) THEN
+      value =  getAttribute(node,"jbegin")
+      CALL zoom__set(pt_zoom,jbegin_glo=string_to_integer(value))
+    ENDIF
+        
+  END SUBROUTINE parsing_zoom_attribute 
+
+
+
+  RECURSIVE SUBROUTINE parsing_field_group(node,parent,root)
+  USE mod_field_definition
+  USE mod_field_group
+  USE mod_field
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER          :: node
+    TYPE(field_group),POINTER     :: parent
+    LOGICAL,INTENT(IN),OPTIONAL   :: root
+    
+    TYPE(field_group),POINTER :: pt_field_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(field),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    LOGICAL            :: is_root
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+    
+    IF (is_root) THEN
+      pt_field_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL field_group__get_new_group(parent,pt_field_group,TRIM(value))
+      ELSE
+        CALL field_group__get_new_group(parent,pt_field_group)
+      ENDIF
+    ENDIF
+      
+    CALL field_group__get_default_attrib(pt_field_group,attribute)
+    CALL parsing_field_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_field_group(child_node,pt_field_group)
+             
+          CASE ('field')
+            CALL parsing_field(child_node,pt_field_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_field'
+              CALL Warning("mod_parse_xml:parsing_group_field")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_field_group
+
+  SUBROUTINE parsing_field(node,parent)
+  USE mod_field_group
+  USE mod_field
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(field_group),POINTER :: parent
+    
+    TYPE(field),POINTER :: pt_field
+    TYPE(field),POINTER       :: attribute
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL field_group__get_new_field(parent,pt_field,TRIM(value))
+    ELSE
+      CALL field_group__get_new_field(parent,pt_field)
+    ENDIF
+      
+    CALL parsing_field_attribute(node,pt_field)
+  
+  END SUBROUTINE parsing_field
+
+  
+  SUBROUTINE parsing_field_attribute(node,pt_field)
+  USE mod_field
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(field),POINTER :: pt_field
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL field__set(pt_field,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL field__set(pt_field,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"unit")) THEN
+      value =  getAttribute(node,"unit")
+      CALL field__set(pt_field,unit=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"operation")) THEN
+      value =  getAttribute(node,"operation")
+      CALL field__set(pt_field,operation=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"freq_op")) THEN
+      value =  getAttribute(node,"freq_op")
+      CALL field__set(pt_field,freq_op=string_to_integer(value))
+    ENDIF
+   
+    IF (is_attribute_exist(node,"axis_ref")) THEN
+      value =  getAttribute(node,"axis_ref")
+      CALL field__set(pt_field,axis_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"grid_ref")) THEN
+      value =  getAttribute(node,"grid_ref")
+      CALL field__set(pt_field,grid_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"zoom_ref")) THEN
+      value =  getAttribute(node,"zoom_ref")
+      CALL field__set(pt_field,zoom_ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"level")) THEN
+      value =  getAttribute(node,"level")
+      CALL field__set(pt_field,level=string_to_integer(value))
+    ENDIF
+    
+    IF (is_attribute_exist(node,"prec")) THEN
+      value =  getAttribute(node,"prec")
+      CALL field__set(pt_field,prec=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"ref")) THEN
+      value =  getAttribute(node,"ref")
+      CALL field__set(pt_field,ref=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"enabled")) THEN
+      value =  getAttribute(node,"enabled")
+      CALL field__set(pt_field,enabled=string_to_logical(value))
+    ENDIF
+  
+
+  END SUBROUTINE parsing_field_attribute 
+
+
+  RECURSIVE SUBROUTINE parsing_file_group(node,parent,root)
+  USE mod_file_definition
+  USE mod_file_group
+  USE mod_file
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER          :: node
+    TYPE(file_group),POINTER      :: parent
+    LOGICAL,INTENT(IN),OPTIONAL   :: root
+
+    TYPE(file_group),POINTER :: pt_file_group
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    TYPE(file),POINTER       :: attribute
+    LOGICAL                  :: is_root
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+    
+    is_root=.FALSE.
+    IF (PRESENT(root)) is_root=root
+  
+    IF (is_root) THEN
+      pt_file_group=>parent
+    ELSE  
+      IF (is_attribute_exist(node,"id")) THEN
+        value=getAttribute(node,"id")
+        CALL file_group__get_new_group(parent,pt_file_group,TRIM(value))
+      ELSE
+        CALL file_group__get_new_group(parent,pt_file_group)
+      ENDIF
+    ENDIF
+      
+    CALL file_group__get_default_attrib(pt_file_group,attribute)
+    CALL parsing_file_attribute(node,attribute)
+    
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_file_group(child_node,pt_file_group)
+             
+          CASE ('file')
+            CALL parsing_file(child_node,pt_file_group)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
+              CALL Warning("mod_parse_xml:parsing_group_file")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+
+  END SUBROUTINE parsing_file_group
+
+  SUBROUTINE parsing_file(node,parent)
+  USE mod_file_group
+  USE mod_file
+  IMPLICIT NONE  
+    TYPE(fnode), POINTER     :: node
+    TYPE(file_group),POINTER :: parent
+    
+    TYPE(file),POINTER :: pt_file
+    TYPE(file),POINTER       :: attribute
+    TYPE(fnode), POINTER     :: child_node
+    TYPE(fnodeList), POINTER :: child_list
+    INTEGER :: il
+    CHARACTER(len=100) :: node_name
+    CHARACTER(len=100) :: value
+  
+      
+    IF (is_attribute_exist(node,"id")) THEN
+      value=getAttribute(node,"id")
+      CALL file_group__get_new_file(parent,pt_file,TRIM(value))
+    ELSE
+      CALL file_group__get_new_file(parent,pt_file)
+    ENDIF
+      
+    CALL parsing_file_attribute(node,pt_file)
+  
+    IF (hasChildNodes(node)) THEN
+      child_list => getChildnodes(node)
+
+      DO il=0,getLength(child_list)-1
+        child_node => item(child_list,il)
+        node_name=getNodename(child_node)
+        
+        SELECT CASE (TRIM(node_name)) 
+        
+          CASE ('group') 
+            CALL parsing_field_group(child_node,pt_file%field_list)
+             
+          CASE ('field')
+            CALL parsing_field(child_node,pt_file%field_list)
+
+          CASE DEFAULT
+            IF (is_bad_node(node_name)) THEN
+              WRITE(message,*) 'Unknown node <<',TRIM(node_name),'>> while parsing group_file'
+              CALL Warning("mod_parse_xml:parsing_group_file")
+            ENDIF
+        END SELECT
+      ENDDO
+    ENDIF
+  END SUBROUTINE parsing_file
+
+  
+  SUBROUTINE parsing_file_attribute(node,pt_file)
+  USE mod_file
+  IMPLICIT NONE
+    TYPE(fnode), POINTER     :: node
+    TYPE(file),POINTER :: pt_file
+
+    CHARACTER(len=100) :: value
+   
+    IF (is_attribute_exist(node,"name")) THEN
+      value =  getAttribute(node,"name")
+      CALL file__set(pt_file,name=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"name_suffix")) THEN
+      value =  getAttribute(node,"name_suffix")
+      CALL file__set(pt_file,name_suffix=TRIM(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"description")) THEN
+      value =  getAttribute(node,"description")
+      CALL file__set(pt_file,description=TRIM(value))
+    ENDIF
+        
+    IF (is_attribute_exist(node,"output_freq")) THEN
+      value =  getAttribute(node,"output_freq")
+      CALL file__set(pt_file,output_freq=string_to_integer(value))
+    ENDIF
+   
+    IF (is_attribute_exist(node,"output_level")) THEN
+      value =  getAttribute(node,"output_level")
+      CALL file__set(pt_file,output_level=string_to_integer(value))
+    ENDIF
+
+    IF (is_attribute_exist(node,"enabled")) THEN
+      value =  getAttribute(node,"enabled")
+      CALL file__set(pt_file,enabled=string_to_logical(value))
+    ENDIF
+
+  END SUBROUTINE parsing_file_attribute
+  
+
+   
+  
+  FUNCTION is_attribute_exist(node, name)
+
+    LOGICAL :: is_attribute_exist
+    TYPE(fnode), POINTER :: node
+    CHARACTER(len=*) :: name
+    CHARACTER(len=100) :: value
+
+    value=""
+    
+    is_attribute_exist= .false.
+    value=getAttribute(node, TRIM(name))
+    IF (value .NE. "") is_attribute_exist= .true.
+
+  END FUNCTION is_attribute_exist
+
+  FUNCTION is_bad_node(node_name)
+  IMPLICIT NONE
+    CHARACTER(len=*),INTENT(IN) :: node_name
+    LOGICAL                     :: is_bad_node
+    
+    IF (TRIM(node_name)=='#text' .OR. TRIM(node_name)=='#comment') THEN
+      is_bad_node=.FALSE.
+    ELSE
+      is_bad_node=.TRUE.
+    ENDIF
+      
+  END FUNCTION is_bad_node
+  
+END MODULE parsing_xml
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_sorted_list.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_sorted_list.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_sorted_list.f90	(revision 2354)
@@ -0,0 +1,167 @@
+MODULE mod_sorted_list
+
+  PRIVATE
+  
+  TYPE node
+   INTEGER :: key
+   INTEGER :: value
+   LOGICAL :: has_value
+   TYPE(node),POINTER :: child1
+   TYPE(node),POINTER :: child2
+  END TYPE node
+
+TYPE, PUBLIC :: sorted_list
+  PRIVATE
+  TYPE(vector_node),POINTER :: tree => NULL()
+  TYPE(node),POINTER        :: first => NULL()
+  INTEGER :: size = 0
+  LOGICAL :: is_init=.FALSE.
+END TYPE sorted_list 
+
+  PUBLIC :: sorted_list__new, sorted_list__add, sorted_list__find, sorted_list__delete 
+INCLUDE 'vector_node_def.inc'
+
+CONTAINS
+
+INCLUDE 'vector_node_contains.inc'
+  
+  SUBROUTINE node__new(Pt_n)
+  IMPLICIT NONE
+    TYPE(node), POINTER :: Pt_n
+    
+    Pt_n%has_value=.FALSE.
+    Pt_n%child1=>NULL()
+    pt_n%child2=>NULL()
+  END SUBROUTINE node__new
+  
+  
+  SUBROUTINE sorted_list__new(Pt_sl)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    TYPE(node), POINTER :: Pt_n
+    
+    IF (Pt_sl%is_init) CALL sorted_list__delete(Pt_sl)
+    
+    ALLOCATE(Pt_sl%tree)
+    CALL vector_node__new(Pt_sl%tree)
+    CALL vector_node__get_new(Pt_sl%tree,Pt_n)
+    CALL node__new(Pt_n)  
+    Pt_sl%first=>Pt_n
+    Pt_sl%Size=0
+    Pt_sl%is_init=.TRUE.
+    
+  END SUBROUTINE  sorted_list__new
+  
+  SUBROUTINE sorted_list__delete(Pt_sl)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    TYPE(node), POINTER :: Pt_n
+
+    IF (Pt_sl%is_init) THEN
+      CALL vector_node__delete(Pt_sl%tree)
+      DEALLOCATE(Pt_sl%tree)
+      Pt_sl%is_init=.FALSE.
+    ENDIF
+   
+  END SUBROUTINE  sorted_list__delete
+
+   
+  SUBROUTINE sorted_list__Add(Pt_sl,key,value)
+  IMPLICIT NONE
+    TYPE(sorted_list), POINTER :: Pt_sl
+    INTEGER,INTENT(IN)  :: key
+    INTEGER,INTENT(IN)  :: value
+
+    LOGICAL               :: Out
+    TYPE(node), POINTER   :: current
+    TYPE(node), POINTER   :: new 
+    
+    
+    CALL vector_node__get_new(Pt_sl%tree,new)
+    CALL node__new(new)
+    current=>Pt_sl%first
+    
+      
+    Out=.FALSE.
+    
+    DO WHILE (.NOT. out)
+      IF (current%has_value) THEN
+        IF (key > current%key) THEN
+          IF (ASSOCIATED(current%child2)) THEN
+            current=>current%child2
+          ELSE
+            current%child2=>new
+            out=.FALSE.
+          ENDIF
+        ELSE
+          IF (ASSOCIATED(current%child1)) THEN
+            current=>current%child1
+          ELSE
+            current%child1=>new
+            out=.FALSE.
+          ENDIF
+        ENDIF 
+      ELSE
+        current%has_value=.TRUE.
+        current%key=key
+        current%value=value
+        out=.TRUE.
+      ENDIF
+    ENDDO
+    
+    Pt_sl%Size=Pt_sl%Size+1
+       
+  END SUBROUTINE sorted_list__Add
+
+  
+  SUBROUTINE sorted_list__find(Pt_sl,key,value,success)
+  IMPLICIT NONE
+    TYPE(sorted_list),POINTER   :: Pt_sl
+    INTEGER,INTENT(IN)          :: key
+    INTEGER,INTENT(OUT)         :: value
+    LOGICAL,INTENT(OUT)         :: success
+    
+    LOGICAL               :: Out
+    TYPE(node), POINTER   :: current
+    
+    current=>Pt_sl%first
+    Out=.FALSE.
+    Success=.FALSE.
+    
+    DO WHILE (.NOT. out)
+      IF (current%has_value) THEN
+        IF (key == current%key) THEN
+          value=current%value
+          success=.TRUE.
+          out=.TRUE.
+        ELSE IF (key > current%key) THEN
+          IF (ASSOCIATED(current%child2)) THEN
+            current=>current%child2
+          ELSE
+            out=.TRUE.
+          ENDIF
+        ELSE
+          IF (ASSOCIATED(current%child1)) THEN
+            current=>current%child1
+          ELSE
+            out=.TRUE.
+          ENDIF
+        ENDIF
+      ELSE
+        out=.TRUE. 
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE sorted_list__find
+
+  
+  SUBROUTINE sorted_list__get_first(Pt_sl,Pt_n)
+  IMPLICIT NONE
+    TYPE(sorted_list),POINTER   :: Pt_sl
+    TYPE(node),POINTER          :: Pt_n
+
+    Pt_n=>Pt_sl%tree%at(1)%Pt
+  END SUBROUTINE sorted_list__get_first  
+
+
+END MODULE mod_sorted_list
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_stdtype.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_stdtype.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_stdtype.f90	(revision 2354)
@@ -0,0 +1,48 @@
+MODULE mod_stdtype
+
+  INTEGER,PARAMETER :: integer0 = 0
+  INTEGER,PARAMETER :: integer1 = 1
+  INTEGER,PARAMETER :: integer2 = 2
+  INTEGER,PARAMETER :: integer3 = 3
+  INTEGER,PARAMETER :: integer4 = 4
+  INTEGER,PARAMETER :: integer5 = 5
+  INTEGER,PARAMETER :: integer6 = 6
+  INTEGER,PARAMETER :: integer7 = 7
+  
+  INTEGER,PARAMETER :: real0    = 8
+  INTEGER,PARAMETER :: real1    = 9
+  INTEGER,PARAMETER :: real2    = 10
+  INTEGER,PARAMETER :: real3    = 11
+  INTEGER,PARAMETER :: real4    = 12
+  INTEGER,PARAMETER :: real5    = 13
+  INTEGER,PARAMETER :: real6    = 14
+  INTEGER,PARAMETER :: real7    = 15
+
+  INTEGER,PARAMETER :: logical0 = 16
+  INTEGER,PARAMETER :: logical1 = 17
+  INTEGER,PARAMETER :: logical2 = 18
+  INTEGER,PARAMETER :: logical3 = 19
+  INTEGER,PARAMETER :: logical4 = 20
+  INTEGER,PARAMETER :: logical5 = 21
+  INTEGER,PARAMETER :: logical6 = 22
+  INTEGER,PARAMETER :: logical7 = 23
+  
+  INTEGER,PARAMETER :: string0  = 24
+  INTEGER,PARAMETER :: string1  = 25
+  INTEGER,PARAMETER :: string2  = 26
+  INTEGER,PARAMETER :: string3  = 27
+  INTEGER,PARAMETER :: string4  = 28
+  INTEGER,PARAMETER :: string5  = 29
+  INTEGER,PARAMETER :: string6  = 30
+  INTEGER,PARAMETER :: string7  = 31
+
+  INTEGER,PARAMETER :: char0   = 32
+  INTEGER,PARAMETER :: char1   = 33
+  INTEGER,PARAMETER :: char2   = 34
+  INTEGER,PARAMETER :: char3   = 35
+  INTEGER,PARAMETER :: char4   = 36
+  INTEGER,PARAMETER :: char5   = 37
+  INTEGER,PARAMETER :: char6   = 38
+  INTEGER,PARAMETER :: char7   = 39
+ 
+END MODULE mod_stdtype
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_time_parameters.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_time_parameters.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_time_parameters.f90	(revision 2354)
@@ -0,0 +1,26 @@
+MODULE mod_time_parameters
+
+  INTEGER,POINTER  :: initial_timestep
+  REAL,POINTER     :: initial_date
+  REAL,POINTER     :: timestep_value 
+  INTEGER,POINTER  :: timestep_number
+
+CONTAINS 
+
+  SUBROUTINE time_parameters__swap_context(saved_initial_timestep,saved_initial_date, &
+                                           saved_timestep_value,saved_timestep_number)
+  IMPLICIT NONE
+    INTEGER,POINTER  :: saved_initial_timestep
+    REAL,POINTER     :: saved_initial_date
+    REAL,POINTER     :: saved_timestep_value 
+    INTEGER,POINTER  :: saved_timestep_number
+   
+    initial_timestep => saved_initial_timestep
+    initial_date     => saved_initial_date
+    timestep_value   => saved_timestep_value 
+    timestep_number  => saved_timestep_number    
+    
+  END SUBROUTINE time_parameters__swap_context  
+    
+                                           
+END MODULE mod_time_parameters
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_vector_field.F90.old
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_vector_field.F90.old	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_vector_field.F90.old	(revision 2354)
@@ -0,0 +1,43 @@
+MODULE mod_field_vector
+  USE mod_field
+  
+  PRIVATE
+  
+   TYPE,PUBLIC :: field_vector
+     PRIVATE
+     TYPE(vector), POINTER :: list
+     TYPE(field),  POINTER :: default_attribut
+   END TYPE field_vector
+
+#define DATA_TYPE field
+#include "vectors_def.inc"
+
+  PUBLIC field_vector__new, field_vector__get_new
+
+CONTAINS
+
+#include "vectors_contains.inc"
+    
+  SUBROUTINE field_vector__new(Pt_vf)
+  IMPLICIT NONE
+    TYPE(field_vector),POINTER  :: Pt_vf
+    
+      CALL vector__new(Pt_vf%list)
+      CALL field__new(Pt_vf%default_attribut)
+  
+  END SUBROUTINE field_vector__new
+  
+
+  SUBROUTINE field_vector__get_new(Pt_vf,Pt_f_out,Id)
+  IMPLICIT NONE  
+    TYPE(field_vector),POINTER           :: Pt_vf
+    TYPE(field),POINTER                  :: Pt_f_out
+    CHARACTER(LEN=str_len),OPTIONAL      :: Id
+      
+      CALL vector__get_new(Pt_vf%list,Pt_f_out)
+      CALL field__new(Pt_f_out)
+   END SUBROUTINE field_vector__get_new
+   
+   
+END MODULE mod_field_vector
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_xmlio_parameters.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_xmlio_parameters.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_xmlio_parameters.f90	(revision 2354)
@@ -0,0 +1,14 @@
+MODULE mod_xmlio_parameters
+
+  INTEGER, PARAMETER :: str_len=100
+  INTEGER, PARAMETER :: array_size_unit=2
+  INTEGER, PARAMETER :: default_vector_size=100
+  REAL, PARAMETER    :: default_vector_grow_factor=1.5
+  INTEGER, PARAMETER :: str_msg_len=1024
+  
+  INTEGER,PARAMETER  :: internal_file=10
+  INTEGER,PARAMETER  :: internal_field=10
+  INTEGER,PARAMETER  :: internal_axis=10
+  INTEGER,PARAMETER  :: internal_grid=10
+  
+END MODULE mod_xmlio_parameters
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_zoom.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_zoom.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_zoom.f90	(revision 2354)
@@ -0,0 +1,201 @@
+MODULE mod_zoom
+  USE mod_xmlio_parameters
+  USE mod_sorted_list
+
+  IMPLICIT NONE
+
+  TYPE,PUBLIC :: zoom
+    CHARACTER(len=str_len)      :: id
+    LOGICAL                     :: has_id
+    CHARACTER(len=str_len)      :: name
+    LOGICAL                     :: has_name
+    CHARACTER(len=str_len)      :: description
+    LOGICAL                     :: has_description
+    INTEGER                     :: ni_glo
+    LOGICAL                     :: has_ni_glo
+    INTEGER                     :: nj_glo
+    LOGICAL                     :: has_nj_glo
+    INTEGER                     :: ibegin_glo
+    LOGICAL                     :: has_ibegin_glo
+    INTEGER                     :: jbegin_glo
+    LOGICAL                     :: has_jbegin_glo
+    INTEGER                     :: ni_loc
+    INTEGER                     :: nj_loc
+    INTEGER                     :: ibegin_loc
+    INTEGER                     :: jbegin_loc
+  END TYPE zoom    
+
+  INCLUDE 'vector_zoom_def.inc'
+
+  TYPE(vector_zoom),POINTER,SAVE             :: zoom_Ids
+  TYPE(sorted_list),POINTER,SAVE,PRIVATE     :: Ids 
+
+  INTERFACE zoom__set_attribut
+    MODULE PROCEDURE zoom__set_attribut_id,zoom__set_attribut_pt
+  END INTERFACE
+  
+CONTAINS
+  
+  INCLUDE 'vector_zoom_contains.inc'
+
+  SUBROUTINE zoom__swap_context(saved_zoom_Ids,saved_Ids)
+  IMPLICIT NONE
+    TYPE(vector_zoom),POINTER          :: saved_zoom_Ids
+    TYPE(sorted_list),POINTER          :: saved_Ids 
+    
+    zoom_ids=>saved_zoom_ids
+    ids=>saved_ids
+  END SUBROUTINE zoom__swap_context
+
+
+  SUBROUTINE zoom__init
+  IMPLICIT NONE
+
+    CALL vector_zoom__new(zoom_Ids)
+    CALL sorted_list__new(Ids)
+    
+  END SUBROUTINE zoom__init
+  
+
+  SUBROUTINE zoom__new(pt_zoom,Id)
+  USE string_function
+  IMPLICIT NONE
+    TYPE(zoom),POINTER :: pt_zoom
+    CHARACTER(LEN=*),OPTIONAL     :: Id
+    INTEGER   :: Pos 
+      
+    pt_zoom%has_id=.FALSE.
+    pt_zoom%has_name=.FALSE.
+    pt_zoom%has_description=.FALSE.
+    pt_zoom%has_ni_glo=.FALSE.
+    pt_zoom%has_nj_glo=.FALSE.
+    pt_zoom%has_ibegin_glo=.FALSE.
+    pt_zoom%has_jbegin_glo=.FALSE.
+     
+    IF (PRESENT(Id)) THEN
+      Pt_zoom%id=TRIM(ADJUSTL(Id))
+      Pt_zoom%has_id=.TRUE.
+     CALL vector_zoom__set_new(zoom_Ids,Pt_zoom,Pos)
+     CALL sorted_list__Add(Ids,hash(id),Pos)
+    ENDIF
+   
+  END SUBROUTINE zoom__new
+   
+  SUBROUTINE zoom__set(pt_zoom,name,description,ni_glo,nj_glo,ibegin_glo,jbegin_glo)
+  IMPLICIT NONE
+    TYPE(zoom),POINTER                   :: pt_zoom
+    CHARACTER(len=*),OPTIONAL            :: name
+    CHARACTER(len=*),OPTIONAL            :: description
+    INTEGER,OPTIONAL                     :: ni_glo
+    INTEGER,OPTIONAL                     :: nj_glo
+    INTEGER,OPTIONAL                     :: ibegin_glo
+    INTEGER,OPTIONAL                     :: jbegin_glo
+    
+    IF (PRESENT(name)) THEN
+      pt_zoom%name=TRIM(ADJUSTL(name))
+      pt_zoom%has_name=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(description)) THEN
+      pt_zoom%name=TRIM(ADJUSTL(description))
+      pt_zoom%has_description=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(ni_glo)) THEN
+      pt_zoom%ni_glo=ni_glo
+      pt_zoom%has_ni_glo=.TRUE.
+    ENDIF
+
+    IF (PRESENT(nj_glo)) THEN
+      pt_zoom%nj_glo=nj_glo
+      pt_zoom%has_nj_glo=.TRUE.
+    ENDIF
+
+    IF (PRESENT(ibegin_glo)) THEN
+      pt_zoom%ibegin_glo=ibegin_glo
+      pt_zoom%has_ibegin_glo=.TRUE.
+    ENDIF
+    
+    IF (PRESENT(jbegin_glo)) THEN
+      pt_zoom%jbegin_glo=jbegin_glo
+      pt_zoom%has_ibegin_glo=.TRUE.
+    ENDIF
+               
+   END SUBROUTINE zoom__set   
+
+  SUBROUTINE zoom__set_attribut_id(id,attrib,ok)
+  USE mod_attribut
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)   :: id
+    TYPE(attribut),INTENT(IN)     :: attrib
+    LOGICAL,OPTIONAL,INTENT(OUT)  :: ok
+    
+    TYPE(zoom),POINTER              :: Pt_zoom
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_zoom=>zoom_ids%at(Pos)%Pt
+      CALL zoom__set_attribut_pt(Pt_zoom,attrib)
+      IF (PRESENT(OK)) OK=.TRUE.
+    ELSE
+      IF (.NOT.PRESENT(OK)) THEN
+        WRITE(message,*) 'zoom id :',id,'is undefined'
+        CALL error('mod_zoom::zoom__set_attribut')
+      ELSE
+        OK=.FALSE.
+      ENDIF
+    ENDIF  
+  
+  END SUBROUTINE zoom__set_attribut_id
+      
+  SUBROUTINE zoom__set_attribut_pt(Pt_zoom,attrib)
+  USE mod_attribut
+  USE mod_zoom_attribut
+  USE error_msg
+  IMPLICIT NONE
+    TYPE(zoom),POINTER        :: Pt_zoom
+    TYPE(attribut),INTENT(IN) :: attrib
+    
+    SELECT CASE(attrib%name)
+      CASE (zoom__name)
+        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,name=attrib%string0_ptr) ; RETURN
+      CASE (zoom__description)
+        IF (attrib%type==string0) CALL  zoom__set(pt_zoom,description=attrib%string0_ptr) ; RETURN
+      CASE (zoom__ni)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ni_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__nj)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,nj_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__ibegin)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,ibegin_glo=attrib%integer0_ptr) ; RETURN
+      CASE (zoom__jbegin)
+        IF (attrib%type==integer0) CALL  zoom__set(pt_zoom,jbegin_glo=attrib%integer0_ptr) ; RETURN
+     END SELECT
+
+     WRITE(message,*) 'zoom attribut ',attrib%name,' : type :',attrib%type,   &
+                      ' : Attribute type is incompatible with the provided value'
+     CALL error('mod_zoom::zoom__set_attribut')
+    
+  END SUBROUTINE zoom__set_attribut_pt
+
+  SUBROUTINE zoom__get(Id,pt_zoom)
+  USE string_function
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN)     :: Id
+    TYPE(zoom),POINTER              :: Pt_zoom
+
+    INTEGER                         :: Pos
+    LOGICAL                         :: success
+    
+    CALL sorted_list__find(Ids,hash(Id),Pos,success)
+    IF (success) THEN
+      Pt_zoom=>zoom_ids%at(Pos)%Pt
+    ELSE
+      Pt_zoom=>NULL()
+    ENDIF
+    
+  END SUBROUTINE zoom__get
+
+END MODULE mod_zoom
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_zoom_attribut.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_zoom_attribut.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/mod_zoom_attribut.f90	(revision 2354)
@@ -0,0 +1,17 @@
+MODULE mod_zoom_attribut
+  USE mod_object
+   
+  INTEGER,PARAMETER :: zoom__begin = zoom_object + 10
+
+  INTEGER,PARAMETER :: zoom__name = zoom_object + 11
+  INTEGER,PARAMETER :: zoom__description = zoom_object + 12
+  INTEGER,PARAMETER :: zoom__ni = zoom_object + 13
+  INTEGER,PARAMETER :: zoom__nj = zoom_object + 14
+  INTEGER,PARAMETER :: zoom__ibegin = zoom_object + 15
+  INTEGER,PARAMETER :: zoom__jbegin = zoom_object + 16
+  
+  INTEGER,PARAMETER :: zoom__end = zoom_object + 17
+
+END MODULE mod_zoom_attribut
+
+
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/string_function.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/string_function.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/string_function.f90	(revision 2354)
@@ -0,0 +1,107 @@
+MODULE string_function
+ 
+
+
+
+CONTAINS
+
+  FUNCTION stdstr(string)
+  USE mod_xmlio_parameters
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: string
+    CHARACTER(LEN=str_len) :: stdstr
+    
+    stdstr=string
+  END FUNCTION stdstr
+    
+  
+  FUNCTION Hash(Str)
+  IMPLICIT NONE  
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    CHARACTER(LEN=LEN(str)) :: new_str
+    INTEGER :: Hash
+    INTEGER :: c
+    INTEGER :: i
+    
+    new_str=ADJUSTL(ADJUSTR(Str))
+    
+    Hash=0
+    DO i=1,LEN_TRIM(new_Str)
+      c = IACHAR(new_Str(i:i))
+      Hash=c+ISHFT(Hash,6)+ISHFT(Hash,16)-Hash
+    ENDDO
+    
+  END FUNCTION Hash
+  
+  FUNCTION String_to_integer(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    INTEGER :: String_to_integer
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_integer
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to integer'
+        CALL Error("string_function:string_to_integer")
+      ENDIF
+    ENDIF
+  END FUNCTION String_to_integer
+  
+  FUNCTION String_to_real(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    REAL    :: String_to_real
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_real
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to real'
+        CALL Error("string_function:string_to_real")
+      ENDIF
+    ENDIF
+    
+  END FUNCTION String_to_real
+  
+  FUNCTION String_to_logical(str,succed)
+  USE error_msg
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: Str
+    LOGICAL,OPTIONAL            :: succed
+    
+    LOGICAL :: String_to_logical
+    INTEGER :: ierr
+    
+    READ(Str,FMT=*,iostat=ierr) String_to_logical
+    
+    IF (PRESENT(succed)) succed=.TRUE.
+      
+    IF (ierr/=0) THEN
+      IF (PRESENT(succed)) THEN
+        succed=.FALSE.
+      ELSE 
+        WRITE (message,*) 'Error when attempting to convert string :<<',TRIM(str),'>> to logical'
+        CALL Error("string_function:string_to_logical")
+      ENDIF
+    ENDIF
+    
+  END FUNCTION String_to_logical
+    
+END MODULE string_function
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/test_xmlio.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/test_xmlio.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/test_xmlio.f90	(revision 2354)
@@ -0,0 +1,85 @@
+PROGRAM test_xmlio
+  USE xmlio
+  USE mod_interface_ioipsl
+  IMPLICIT NONE
+  
+  TYPE(field),POINTER :: Pt_f
+  TYPE(field_group),POINTER :: Pt_fg
+  TYPE(file),POINTER :: Pt_file
+  TYPE(grid),POINTER :: pt_grid 
+  INTEGER,PARAMETER  :: ni=360
+  INTEGER,PARAMETER  :: nj=180
+  REAL,DIMENSION(ni,nj) :: lon
+  REAL,DIMENSION(ni,nj) :: lat
+  INTEGER               :: i,j
+  TYPE(axis),POINTER :: pt_axis 
+  
+  DO i=1,ni
+    DO j=1,nj
+      lon(i,j)=i
+      lat(i,j)=j
+    ENDDO
+  ENDDO  
+  
+  
+  
+  CALL xmlio__init("iodef.xml")
+
+  CALL grid__get("grid_T",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_U",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_V",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+
+  CALL grid__get("grid_W",pt_grid)
+  CALL domain__set(pt_grid%domain,0,ni,nj,1,1,lon,lat)
+  
+  CALL axis__get("deptht",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthu",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthv",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+  CALL axis__get("depthw",pt_axis)
+  CALL axis__set(pt_axis,a_size=5,values=(/1.,2.,3.,4.,5./))
+
+
+  CALL axis_group__apply_default(axis_definition)
+  CALL grid_group__apply_default(grid_definition)
+  CALL field_group__apply_default(field_definition)
+  CALL file_group__apply_default(file_definition)
+  
+  CALL field_group__solve_ref(field_definition)
+  CALL file_group__solve_field_ref(file_definition)
+
+  CALL file_group__check(file_definition)
+  CALL axis_group__check(axis_definition)
+
+!
+  CALL axis_group__print(axis_definition)
+  CALL grid_group__print(grid_definition)
+  CALL field_group__print(field_definition)
+  CALL file_group__print(file_definition)
+!  CALL field_group__get_new_field(field_definition,pt_f,"toto")
+!  CALL field__set(Pt_f,name="toto",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"tata")
+!  CALL field__set(Pt_f,name="tata",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"titi")
+!  CALL field__set(Pt_f,name="titi",unit="kg")
+!  CALL field_group__get_new_field(field_definition,pt_f,"xyz")
+!  CALL field__set(Pt_f,name="xyz",unit="kg")
+   CALL set_file_dependency
+   CALL set_field_enabled
+   CALL set_field_dependency
+   
+   CALL set_time_parameters(0,0.,3600.)
+   
+   CALL create_header
+   
+END PROGRAM test_xmlio
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_axis__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_axis), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_axis__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_axis__new
+  
+  SUBROUTINE vector_axis__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_axis), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL axis__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_axis__delete
+  
+  SUBROUTINE vector_axis__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis), INTENT(INOUT)   :: vect
+    TYPE(axis),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis__get_new
+
+  SUBROUTINE vector_axis__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis), INTENT(INOUT)   :: vect
+    TYPE(axis),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis__set_new
+  
+  SUBROUTINE vector_axis__increase(vect)
+    TYPE(vector_axis), INTENT(INOUT) :: vect
+    TYPE (Pt_axis__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_axis__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_axis__ 
+    TYPE (axis),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_axis__
+
+  TYPE vector_axis
+  
+    TYPE (Pt_axis__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_axis
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_group_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_group_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_group_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_axis_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_axis_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_axis_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_axis_group__new
+  
+  SUBROUTINE vector_axis_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_axis_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL axis_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_axis_group__delete
+  
+  SUBROUTINE vector_axis_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis_group), INTENT(INOUT)   :: vect
+    TYPE(axis_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis_group__get_new
+
+  SUBROUTINE vector_axis_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_axis_group), INTENT(INOUT)   :: vect
+    TYPE(axis_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_axis_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_axis_group__set_new
+  
+  SUBROUTINE vector_axis_group__increase(vect)
+    TYPE(vector_axis_group), INTENT(INOUT) :: vect
+    TYPE (Pt_axis_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_axis_group__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_group_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_group_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_axis_group_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_axis_group__ 
+    TYPE (axis_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_axis_group__
+
+  TYPE vector_axis_group
+  
+    TYPE (Pt_axis_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_axis_group
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_contains.template
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_contains.template	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_contains.template	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_#TYPE#__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_#TYPE#), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_#TYPE#__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_#TYPE#__new
+  
+  SUBROUTINE vector_#TYPE#__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_#TYPE#), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL #TYPE#__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_#TYPE#__delete
+  
+  SUBROUTINE vector_#TYPE#__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_#TYPE#), INTENT(INOUT)   :: vect
+    TYPE(#TYPE#),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_#TYPE#__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_#TYPE#__get_new
+
+  SUBROUTINE vector_#TYPE#__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_#TYPE#), INTENT(INOUT)   :: vect
+    TYPE(#TYPE#),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_#TYPE#__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_#TYPE#__set_new
+  
+  SUBROUTINE vector_#TYPE#__increase(vect)
+    TYPE(vector_#TYPE#), INTENT(INOUT) :: vect
+    TYPE (Pt_#TYPE#__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_#TYPE#__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_context_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_context_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_context_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_context__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_context), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_context__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_context__new
+  
+  SUBROUTINE vector_context__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_context), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL context__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_context__delete
+  
+  SUBROUTINE vector_context__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_context), INTENT(INOUT)   :: vect
+    TYPE(context),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_context__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_context__get_new
+
+  SUBROUTINE vector_context__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_context), INTENT(INOUT)   :: vect
+    TYPE(context),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_context__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_context__set_new
+  
+  SUBROUTINE vector_context__increase(vect)
+    TYPE(vector_context), INTENT(INOUT) :: vect
+    TYPE (Pt_context__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_context__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_context_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_context_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_context_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_context__ 
+    TYPE (context),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_context__
+
+  TYPE vector_context
+  
+    TYPE (Pt_context__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_context
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_def.template
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_def.template	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_def.template	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_#TYPE#__ 
+    TYPE (#TYPE#),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_#TYPE#__
+
+  TYPE vector_#TYPE#
+  
+    TYPE (Pt_#TYPE#__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_#TYPE#
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_domain_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_domain_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_domain_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_domain__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_domain), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_domain__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_domain__new
+  
+  SUBROUTINE vector_domain__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_domain), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL domain__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_domain__delete
+  
+  SUBROUTINE vector_domain__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_domain), INTENT(INOUT)   :: vect
+    TYPE(domain),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_domain__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_domain__get_new
+
+  SUBROUTINE vector_domain__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_domain), INTENT(INOUT)   :: vect
+    TYPE(domain),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_domain__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_domain__set_new
+  
+  SUBROUTINE vector_domain__increase(vect)
+    TYPE(vector_domain), INTENT(INOUT) :: vect
+    TYPE (Pt_domain__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_domain__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_domain_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_domain_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_domain_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_domain__ 
+    TYPE (domain),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_domain__
+
+  TYPE vector_domain
+  
+    TYPE (Pt_domain__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_domain
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field__new
+  
+  SUBROUTINE vector_field__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field__delete
+  
+  SUBROUTINE vector_field__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field), INTENT(INOUT)   :: vect
+    TYPE(field),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field__get_new
+
+  SUBROUTINE vector_field__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field), INTENT(INOUT)   :: vect
+    TYPE(field),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field__set_new
+  
+  SUBROUTINE vector_field__increase(vect)
+    TYPE(vector_field), INTENT(INOUT) :: vect
+    TYPE (Pt_field__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field__ 
+    TYPE (field),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field__
+
+  TYPE vector_field
+  
+    TYPE (Pt_field__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_dep_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_dep_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_dep_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_dep__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_dep), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_dep__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_dep__new
+  
+  SUBROUTINE vector_field_dep__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_dep), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_dep__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_dep__delete
+  
+  SUBROUTINE vector_field_dep__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_dep), INTENT(INOUT)   :: vect
+    TYPE(field_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_dep__get_new
+
+  SUBROUTINE vector_field_dep__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_dep), INTENT(INOUT)   :: vect
+    TYPE(field_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_dep__set_new
+  
+  SUBROUTINE vector_field_dep__increase(vect)
+    TYPE(vector_field_dep), INTENT(INOUT) :: vect
+    TYPE (Pt_field_dep__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_dep__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_dep_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_dep_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_dep_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_dep__ 
+    TYPE (field_dep),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_dep__
+
+  TYPE vector_field_dep
+  
+    TYPE (Pt_field_dep__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_dep
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_group_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_group_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_group_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_group__new
+  
+  SUBROUTINE vector_field_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_group__delete
+  
+  SUBROUTINE vector_field_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_group), INTENT(INOUT)   :: vect
+    TYPE(field_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_group__get_new
+
+  SUBROUTINE vector_field_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_group), INTENT(INOUT)   :: vect
+    TYPE(field_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_group__set_new
+  
+  SUBROUTINE vector_field_group__increase(vect)
+    TYPE(vector_field_group), INTENT(INOUT) :: vect
+    TYPE (Pt_field_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_group__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_group_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_group_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_group_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_group__ 
+    TYPE (field_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_group__
+
+  TYPE vector_field_group
+  
+    TYPE (Pt_field_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_group
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_out_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_out_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_out_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_field_out__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_field_out), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_field_out__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_field_out__new
+  
+  SUBROUTINE vector_field_out__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_field_out), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL field_out__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_field_out__delete
+  
+  SUBROUTINE vector_field_out__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_out), INTENT(INOUT)   :: vect
+    TYPE(field_out),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_out__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_out__get_new
+
+  SUBROUTINE vector_field_out__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_field_out), INTENT(INOUT)   :: vect
+    TYPE(field_out),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_field_out__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_field_out__set_new
+  
+  SUBROUTINE vector_field_out__increase(vect)
+    TYPE(vector_field_out), INTENT(INOUT) :: vect
+    TYPE (Pt_field_out__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_field_out__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_out_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_out_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_field_out_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_field_out__ 
+    TYPE (field_out),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_field_out__
+
+  TYPE vector_field_out
+  
+    TYPE (Pt_field_out__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_field_out
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file__new
+  
+  SUBROUTINE vector_file__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file__delete
+  
+  SUBROUTINE vector_file__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file), INTENT(INOUT)   :: vect
+    TYPE(file),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file__get_new
+
+  SUBROUTINE vector_file__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file), INTENT(INOUT)   :: vect
+    TYPE(file),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file__set_new
+  
+  SUBROUTINE vector_file__increase(vect)
+    TYPE(vector_file), INTENT(INOUT) :: vect
+    TYPE (Pt_file__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file__ 
+    TYPE (file),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file__
+
+  TYPE vector_file
+  
+    TYPE (Pt_file__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_dep_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_dep_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_dep_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file_dep__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file_dep), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file_dep__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file_dep__new
+  
+  SUBROUTINE vector_file_dep__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file_dep), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file_dep__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file_dep__delete
+  
+  SUBROUTINE vector_file_dep__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_dep), INTENT(INOUT)   :: vect
+    TYPE(file_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_dep__get_new
+
+  SUBROUTINE vector_file_dep__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_dep), INTENT(INOUT)   :: vect
+    TYPE(file_dep),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_dep__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_dep__set_new
+  
+  SUBROUTINE vector_file_dep__increase(vect)
+    TYPE(vector_file_dep), INTENT(INOUT) :: vect
+    TYPE (Pt_file_dep__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file_dep__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_dep_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_dep_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_dep_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file_dep__ 
+    TYPE (file_dep),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file_dep__
+
+  TYPE vector_file_dep
+  
+    TYPE (Pt_file_dep__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file_dep
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_group_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_group_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_group_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_file_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_file_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_file_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_file_group__new
+  
+  SUBROUTINE vector_file_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_file_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL file_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_file_group__delete
+  
+  SUBROUTINE vector_file_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_group), INTENT(INOUT)   :: vect
+    TYPE(file_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_group__get_new
+
+  SUBROUTINE vector_file_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_file_group), INTENT(INOUT)   :: vect
+    TYPE(file_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_file_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_file_group__set_new
+  
+  SUBROUTINE vector_file_group__increase(vect)
+    TYPE(vector_file_group), INTENT(INOUT) :: vect
+    TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_file_group__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_group_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_group_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_file_group_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_file_group__ 
+    TYPE (file_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_file_group__
+
+  TYPE vector_file_group
+  
+    TYPE (Pt_file_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_file_group
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_grid__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_grid), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_grid__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_grid__new
+  
+  SUBROUTINE vector_grid__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_grid), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL grid__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_grid__delete
+  
+  SUBROUTINE vector_grid__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid), INTENT(INOUT)   :: vect
+    TYPE(grid),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid__get_new
+
+  SUBROUTINE vector_grid__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid), INTENT(INOUT)   :: vect
+    TYPE(grid),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid__set_new
+  
+  SUBROUTINE vector_grid__increase(vect)
+    TYPE(vector_grid), INTENT(INOUT) :: vect
+    TYPE (Pt_grid__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_grid__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_grid__ 
+    TYPE (grid),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_grid__
+
+  TYPE vector_grid
+  
+    TYPE (Pt_grid__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_grid
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_group_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_group_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_group_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_grid_group__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_grid_group), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_grid_group__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_grid_group__new
+  
+  SUBROUTINE vector_grid_group__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_grid_group), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL grid_group__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_grid_group__delete
+  
+  SUBROUTINE vector_grid_group__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid_group), INTENT(INOUT)   :: vect
+    TYPE(grid_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid_group__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid_group__get_new
+
+  SUBROUTINE vector_grid_group__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_grid_group), INTENT(INOUT)   :: vect
+    TYPE(grid_group),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_grid_group__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_grid_group__set_new
+  
+  SUBROUTINE vector_grid_group__increase(vect)
+    TYPE(vector_grid_group), INTENT(INOUT) :: vect
+    TYPE (Pt_grid_group__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_grid_group__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_group_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_group_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_grid_group_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_grid_group__ 
+    TYPE (grid_group),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_grid_group__
+
+  TYPE vector_grid_group
+  
+    TYPE (Pt_grid_group__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_grid_group
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_node_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_node_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_node_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_node__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_node), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_node__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_node__new
+  
+  SUBROUTINE vector_node__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_node), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL node__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_node__delete
+  
+  SUBROUTINE vector_node__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_node), INTENT(INOUT)   :: vect
+    TYPE(node),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_node__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_node__get_new
+
+  SUBROUTINE vector_node__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_node), INTENT(INOUT)   :: vect
+    TYPE(node),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_node__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_node__set_new
+  
+  SUBROUTINE vector_node__increase(vect)
+    TYPE(vector_node), INTENT(INOUT) :: vect
+    TYPE (Pt_node__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_node__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_node_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_node_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_node_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_node__ 
+    TYPE (node),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_node__
+
+  TYPE vector_node
+  
+    TYPE (Pt_node__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_node
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_zoom_contains.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_zoom_contains.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_zoom_contains.inc	(revision 2354)
@@ -0,0 +1,89 @@
+
+  SUBROUTINE vector_zoom__new(vect,vect_size)
+  use mod_xmlio_parameters
+  IMPLICIT NONE
+    TYPE(vector_zoom), INTENT(INOUT) :: vect
+    INTEGER, OPTIONAL, INTENT(IN) :: vect_size
+     
+    IF (ASSOCIATED(vect%at)) CALL vector_zoom__delete(vect)
+    
+    IF (PRESENT(vect_size)) THEN 
+      vect%size_max=MAX(1,vect_size)
+    ELSE
+      vect%size_max=default_vector_size
+    ENDIF
+    
+    ALLOCATE(vect%at(vect%size_max))
+    
+    vect%size=0
+    vect%grow_factor=default_vector_grow_factor
+    
+  END SUBROUTINE vector_zoom__new
+  
+  SUBROUTINE vector_zoom__delete(vect)
+  IMPLICIT NONE
+    TYPE(vector_zoom), INTENT(IN OUT) :: vect
+    
+    INTEGER                             :: i
+    
+    DO i=1,vect%size
+      IF (vect%at(i)%owned) DEALLOCATE(vect%at(i)%Pt)
+! doit-on avoir une subroutine du genre : CALL zoom__delete() ???
+    ENDDO 
+    
+    IF (ASSOCIATED(vect%at)) DEALLOCATE(vect%at)
+    vect%size_max=0
+    
+  END SUBROUTINE vector_zoom__delete
+  
+  SUBROUTINE vector_zoom__get_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_zoom), INTENT(INOUT)   :: vect
+    TYPE(zoom),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_zoom__increase(vect)
+    
+    vect%size=vect%size+1
+    ALLOCATE(vect%at(vect%size)%pt)
+    vect%at(vect%size)%owned=.TRUE.
+    pt_value=>vect%at(vect%size)%pt
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_zoom__get_new
+
+  SUBROUTINE vector_zoom__set_new(vect,pt_value,pos)
+  IMPLICIT NONE
+  
+    TYPE(vector_zoom), INTENT(INOUT)   :: vect
+    TYPE(zoom),POINTER                 :: pt_value
+    INTEGER,OPTIONAL,INTENT(OUT)         :: Pos
+    
+    IF (vect%size==vect%size_max) CALL vector_zoom__increase(vect)
+    
+    vect%size=vect%size+1
+    vect%at(vect%size)%pt=>pt_value
+    vect%at(vect%size)%owned=.FALSE.
+    IF (PRESENT(pos)) pos=vect%size
+    
+  END SUBROUTINE vector_zoom__set_new
+  
+  SUBROUTINE vector_zoom__increase(vect)
+    TYPE(vector_zoom), INTENT(INOUT) :: vect
+    TYPE (Pt_zoom__), POINTER, DIMENSION(:) :: Pt_tmp
+    INTEGER :: new_size
+    INTEGER :: i
+    
+    vect%size_max=MAX(vect%size_max+1,INT(vect%size_max*vect%grow_factor))
+    ALLOCATE(Pt_tmp(vect%size_max))
+    
+    DO i=1,vect%size
+     Pt_tmp(i)%pt=>vect%at(i)%pt
+    ENDDO
+    
+    DEALLOCATE(vect%at)
+    vect%at=>Pt_tmp
+    
+  END SUBROUTINE vector_zoom__increase 
+    
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_zoom_def.inc
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_zoom_def.inc	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/vector_zoom_def.inc	(revision 2354)
@@ -0,0 +1,17 @@
+
+  TYPE Pt_zoom__ 
+    TYPE (zoom),POINTER :: Pt
+    LOGICAL               :: owned
+  END TYPE Pt_zoom__
+
+  TYPE vector_zoom
+  
+    TYPE (Pt_zoom__), POINTER, DIMENSION(:) :: at => NULL()
+    INTEGER :: size
+    
+    INTEGER :: size_max
+    REAL    :: grow_factor
+    INTEGER :: chunk
+  
+  END TYPE vector_zoom
+  
Index: /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/xmlio.f90
===================================================================
--- /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/xmlio.f90	(revision 2354)
+++ /OBSOLETE/XMLIO_SERVER/trunk/src/XMLIO/xmlio.f90	(revision 2354)
@@ -0,0 +1,53 @@
+MODULE xmlio
+
+  USE mod_field
+  USE mod_field_group
+  USE mod_field_definition
+  USE mod_grid
+  USE mod_grid_group
+  USE mod_grid_definition
+  USE mod_axis
+  USE mod_axis_group
+  USE mod_axis_definition
+  USE mod_file
+  USE mod_file_group
+  USE mod_file_definition
+  USE mod_dependency
+  USE string_function
+  USE error_msg
+  USE mod_context
+  USE mod_time_parameters
+  
+CONTAINS
+
+  SUBROUTINE xmlio__Init(xml_file)
+  USE parsing_xml
+  IMPLICIT NONE
+    CHARACTER(LEN=*),INTENT(IN) :: xml_file
+    
+    CALL context__init
+    CALL parsing_xml_file(xml_file)
+    
+  END SUBROUTINE xmlio__init
+  
+  
+  SUBROUTINE xmlio__close_definition
+  IMPLICIT NONE
+  
+    CALL axis_group__apply_default(axis_definition)
+    CALL grid_group__apply_default(grid_definition)
+    CALL field_group__apply_default(field_definition)
+    CALL file_group__apply_default(file_definition)
+  
+    CALL field_group__solve_ref(field_definition)
+    CALL file_group__solve_field_ref(file_definition)
+
+    CALL file_group__check(file_definition)
+    CALL axis_group__check(axis_definition)
+    CALL grid_group__process_domain(grid_definition)
+     
+    CALL set_dependency
+
+  END SUBROUTINE xmlio__close_definition
+
+END MODULE xmlio
