Index: vendors/AGRIF/AGRIF_FILES/modarrays.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modarrays.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modarrays.F90	(revision 9621)
@@ -0,0 +1,826 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Arrays
+!
+module Agrif_Arrays
+!
+    use Agrif_Types
+    use Agrif_Grids
+!
+    implicit none
+!
+#if defined AGRIF_MPI
+    interface
+        subroutine Agrif_InvLoc ( indloc, proc_id, dir, indglob )
+            integer, intent(in)     :: indloc   !< local index
+            integer, intent(in)     :: proc_id  !< rank of the proc calling this function
+            integer, intent(in)     :: dir      !< direction of the index
+            integer, intent(out)    :: indglob  !< global index
+        end subroutine Agrif_InvLoc
+    end interface
+    private :: Agrif_InvLoc
+#endif
+!
+contains
+!
+!===================================================================================================
+! subroutine Agrif_Childbounds
+!
+!> Computes the global indices of the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Childbounds ( nbdim,           &
+                               lb_var, ub_var,  &
+                               lb_tab, ub_tab,  &
+                               proc_id,         &
+                               coords,          &
+                               lb_tab_true, ub_tab_true, memberin )
+!---------------------------------------------------------------------------------------------------
+    integer,                   intent(in)  :: nbdim         !< Number of dimensions
+    integer, dimension(nbdim), intent(in)  :: lb_var        !< Local lower boundary on the current processor
+    integer, dimension(nbdim), intent(in)  :: ub_var        !< Local upper boundary on the current processor
+    integer, dimension(nbdim), intent(in)  :: lb_tab        !< Global lower boundary of the variable
+    integer, dimension(nbdim), intent(in)  :: ub_tab        !< Global upper boundary of the variable
+    integer,                   intent(in)  :: proc_id       !< Current processor
+    integer, dimension(nbdim), intent(in)  :: coords
+    integer, dimension(nbdim), intent(out) :: lb_tab_true   !< Global value of lb_var on the current processor
+    integer, dimension(nbdim), intent(out) :: ub_tab_true   !< Global value of ub_var on the current processor
+    logical,                   intent(out) :: memberin
+!
+    integer :: i, coord_i
+    integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices
+!
+    do i = 1, nbdim
+!
+        coord_i = coords(i)
+!
+#if defined AGRIF_MPI
+        call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index )
+        call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index )
+#else
+        lb_glob_index = lb_var(i)
+        ub_glob_index = ub_var(i)
+#endif
+        lb_tab_true(i) = max(lb_tab(i), lb_glob_index)
+        ub_tab_true(i) = min(ub_tab(i), ub_glob_index)
+    enddo
+!
+    memberin = .true.
+    do i = 1,nbdim
+        if (ub_tab_true(i) < lb_tab_true(i)) then
+            memberin = .false.
+            exit
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Childbounds
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),        intent(in)  :: var
+    integer, dimension(nbdim,2), intent(out) :: lubglob
+    integer,                     intent(in)  :: nbdim
+!
+#if defined AGRIF_MPI
+    include 'mpif.h'
+    integer, dimension(nbdim)   :: lb, ub
+    integer, dimension(nbdim,2) :: iminmaxg
+    integer :: i, code, coord_i
+#endif
+!
+#if !defined AGRIF_MPI
+    call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim)
+#else
+    call Agrif_get_var_bounds_array(var, lb, ub, nbdim)
+
+    do i = 1,nbdim
+        coord_i = var % root_var % coords(i)
+        call Agrif_InvLoc( lb(i), Agrif_Procrank, coord_i, iminmaxg(i,1) )
+        call Agrif_InvLoc( ub(i), Agrif_Procrank, coord_i, iminmaxg(i,2) )
+    enddo
+!
+    iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
+    call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, Agrif_mpi_comm, code)
+    lubglob(1:nbdim,2)  = - lubglob(1:nbdim,2)
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_global_bounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_get_var_bounds
+!
+!> Gets the lower and the upper boundaries of a variable, for one particular direction.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds ( variable, lower, upper, index )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(in)    :: variable   !< Variable for which we want to extract boundaries
+    integer,              intent(out)   :: lower      !< Lower bound
+    integer,              intent(out)   :: upper      !< Upper bound
+    integer,              intent(in)    :: index      !< Direction for wich we want to know the boundaries
+!
+    lower = variable % lb(index)
+    upper = variable % ub(index)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_bounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_get_var_bounds_array
+!
+!> Gets the lower and the upper boundaries of a table.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(in)   :: variable   !< Variable for which we want to extract boundaries
+    integer, dimension(nbdim), intent(out)  :: lower      !< Lower bounds array
+    integer, dimension(nbdim), intent(out)  :: upper      !< Upper bounds array
+    integer, intent(in)                     :: nbdim      !< Numer of dimensions of the variable
+!
+    lower = variable % lb(1:nbdim)
+    upper = variable % ub(1:nbdim)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_get_var_bounds_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_array_allocate
+!
+!> Allocates data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_array_allocate ( variable, lb, ub, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: variable    !< Variable struct for allocation
+    integer, dimension(nbdim), intent(in)    :: lb          !< Lower bound
+    integer, dimension(nbdim), intent(in)    :: ub          !< Upper bound
+    integer,                   intent(in)    :: nbdim       !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; allocate(variable%array1(lb(1):ub(1)))
+    case (2) ; allocate(variable%array2(lb(1):ub(1),lb(2):ub(2)))
+    case (3) ; allocate(variable%array3(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3)))
+    case (4) ; allocate(variable%array4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4)))
+    case (5) ; allocate(variable%array5(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5)))
+    case (6) ; allocate(variable%array6(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6)))
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_array_allocate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_array_deallocate
+!
+!> Dellocates data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_array_deallocate ( variable, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: variable     !< Variable struct for deallocation
+    integer,              intent(in)    :: nbdim        !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; deallocate(variable%array1)
+    case (2) ; deallocate(variable%array2)
+    case (3) ; deallocate(variable%array3)
+    case (4) ; deallocate(variable%array4)
+    case (5) ; deallocate(variable%array5)
+    case (6) ; deallocate(variable%array6)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_array_deallocate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_set_array_tozero
+!
+!> Reset the value of the data array in \b variable, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_set_array_tozero ( variable, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: variable     !< Variable
+    integer, intent(in)                 :: nbdim        !< Dimension of the array you want to reset
+!
+    select case (nbdim)
+    case (1) ; call Agrif_set_array_tozero_1D(variable%array1)
+    case (2) ; call Agrif_set_array_tozero_2D(variable%array2)
+    case (3) ; call Agrif_set_array_tozero_3D(variable%array3)
+    case (4) ; call Agrif_set_array_tozero_4D(variable%array4)
+    case (5) ; call Agrif_set_array_tozero_5D(variable%array5)
+    case (6) ; call Agrif_set_array_tozero_6D(variable%array6)
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+    subroutine Agrif_set_array_tozero_1D ( array )
+        real, dimension(:),           intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_1D
+!
+    subroutine Agrif_set_array_tozero_2D ( array )
+        real, dimension(:,:),         intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_2D
+!
+    subroutine Agrif_set_array_tozero_3D ( array )
+        real, dimension(:,:,:),       intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_3D
+!
+    subroutine Agrif_set_array_tozero_4D ( array )
+        real, dimension(:,:,:,:),     intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_4D
+!
+    subroutine Agrif_set_array_tozero_5D ( array )
+        real, dimension(:,:,:,:,:),   intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_5D
+!
+    subroutine Agrif_set_array_tozero_6D ( array )
+        real, dimension(:,:,:,:,:,:), intent(out) :: array
+        array = 0.
+    end subroutine Agrif_set_array_tozero_6D
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_set_array_tozero
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_copy_array
+!
+!> Copy a part of data array from var2 to var1
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_copy_array ( var1, inf1, sup1, var2, inf2, sup2, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
+    integer, dimension(nbdim), intent(in)    :: inf1    !< Lower boundary for var1
+    integer, dimension(nbdim), intent(in)    :: sup1    !< Upper boundary for var1
+    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
+    integer, dimension(nbdim), intent(in)    :: inf2    !< Lower boundary for var2
+    integer, dimension(nbdim), intent(in)    :: sup2    !< Upper boundary for var2
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; var1%array1(inf1(1):sup1(1)) = var2%array1(inf2(1):sup2(1))
+    case (2) ; call Agrif_copy_array_2d( var1%array2, var2%array2, &
+                                         lbound(var1%array2), lbound(var2%array2), inf1, sup1, inf2, sup2 )
+    case (3) ; call Agrif_copy_array_3d( var1%array3, var2%array3, &
+                                         lbound(var1%array3), lbound(var2%array3), inf1, sup1, inf2, sup2 )
+    case (4) ; call Agrif_copy_array_4d( var1%array4, var2%array4, &
+                                         lbound(var1%array4), lbound(var2%array4), inf1, sup1, inf2, sup2 )
+    case (5) ; var1%array5(inf1(1):sup1(1),   &
+                           inf1(2):sup1(2),   &
+                           inf1(3):sup1(3),   &
+                           inf1(4):sup1(4),   &
+                           inf1(5):sup1(5)) = var2%array5(inf2(1):sup2(1), &
+                                                          inf2(2):sup2(2), &
+                                                          inf2(3):sup2(3), &
+                                                          inf2(4):sup2(4), &
+                                                          inf2(5):sup2(5))
+    case (6) ; var1%array6(inf1(1):sup1(1),   &
+                           inf1(2):sup1(2),   &
+                           inf1(3):sup1(3),   &
+                           inf1(4):sup1(4),   &
+                           inf1(5):sup1(5),   &
+                           inf1(6):sup1(6)) = var2%array6(inf2(1):sup2(1), &
+                                                          inf2(2):sup2(2), &
+                                                          inf2(3):sup2(3), &
+                                                          inf2(4):sup2(4), &
+                                                          inf2(5):sup2(5), &
+                                                          inf2(6):sup2(6))
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+    subroutine Agrif_copy_array_2d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(2), intent(in)   :: l, m
+        integer, dimension(2), intent(in)   :: inf1, sup1
+        integer, dimension(2), intent(in)   :: inf2, sup2
+        real, dimension(l(1):,l(2):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2))
+    end subroutine Agrif_copy_array_2d
+!
+    subroutine Agrif_copy_array_3d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(3), intent(in)   :: l, m
+        integer, dimension(3), intent(in)   :: inf1, sup1
+        integer, dimension(3), intent(in)   :: inf2,sup2
+        real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):,m(3):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2), &
+               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2), &
+                                        inf2(3):sup2(3))
+    end subroutine Agrif_copy_array_3d
+!
+    subroutine Agrif_copy_array_4d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 )
+        integer, dimension(4), intent(in)   :: l, m
+        integer, dimension(4), intent(in)   :: inf1, sup1
+        integer, dimension(4), intent(in)   :: inf2, sup2
+        real, dimension(l(1):,l(2):,l(3):,l(4):), intent(out) :: tabout
+        real, dimension(m(1):,m(2):,m(3):,m(4):), intent(in)  :: tabin
+        tabout(inf1(1):sup1(1), &
+               inf1(2):sup1(2), &
+               inf1(3):sup1(3), &
+               inf1(4):sup1(4)) = tabin(inf2(1):sup2(1), &
+                                        inf2(2):sup2(2), &
+                                        inf2(3):sup2(3), &
+                                        inf2(4):sup2(4))
+    end subroutine Agrif_copy_array_4d
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_copy_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_var_full_copy_array
+!
+!> Copy the full data array from var2 to var1
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_full_copy_array ( var1, var2, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(inout) :: var1    !< Modified variable
+    type(Agrif_Variable), intent(in)    :: var2    !< Input variable
+    integer,              intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1) ; var1 % array1 = var2 % array1
+    case (2) ; var1 % array2 = var2 % array2
+    case (3) ; var1 % array3 = var2 % array3
+    case (4) ; var1 % array4 = var2 % array4
+    case (5) ; var1 % array5 = var2 % array5
+    case (6) ; var1 % array6 = var2 % array6
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_full_copy_array
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine GiveAgrif_SpecialValueToTab_mpi
+!
+!> Copy \b value in data array \b var2 where it is present in \b var1.
+!---------------------------------------------------------------------------------------------------
+subroutine GiveAgrif_SpecialValueToTab_mpi ( var1, var2, bounds, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(in)    :: var1    !< Modified variable
+    type(Agrif_Variable),      intent(inout) :: var2    !< Input variable
+    integer, dimension(:,:,:), intent(in)    :: bounds  !< Bound for both arrays
+    real,                      intent(in)    :: value   !< Special value
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    select case (nbdim)
+    case (1)
+        where (var1 % array1(bounds(1,1,2):bounds(1,2,2)) == value )
+            var2 % array1(bounds(1,1,1):bounds(1,2,1)) = value
+        end where
+    case (2)
+        where (var1 % array2(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2)) == value)
+            var2 % array2(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1)) = value
+        end where
+    case (3)
+        where (var1 % array3(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2)) == value)
+            var2 % array3(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1)) = value
+        end where
+    case (4)
+        where (var1 % array4(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2)) == value)
+            var2 % array4(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1)) = value
+        end where
+    case (5)
+        where (var1 % array5(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2), &
+                             bounds(5,1,2):bounds(5,2,2)) == value)
+            var2 % array5(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1), &
+                          bounds(5,1,1):bounds(5,2,1)) = value
+        end where
+    case (6)
+        where (var1 % array6(bounds(1,1,2):bounds(1,2,2), &
+                             bounds(2,1,2):bounds(2,2,2), &
+                             bounds(3,1,2):bounds(3,2,2), &
+                             bounds(4,1,2):bounds(4,2,2), &
+                             bounds(5,1,2):bounds(5,2,2), &
+                             bounds(6,1,2):bounds(6,2,2)) == value)
+            var2 % array6(bounds(1,1,1):bounds(1,2,1), &
+                          bounds(2,1,1):bounds(2,2,1), &
+                          bounds(3,1,1):bounds(3,2,1), &
+                          bounds(4,1,1):bounds(4,2,1), &
+                          bounds(5,1,1):bounds(5,2,1), &
+                          bounds(6,1,1):bounds(6,2,1)) = value
+        end where
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine GiveAgrif_SpecialValueToTab_mpi
+!===================================================================================================
+!
+! no more used ???
+#if 0
+!===================================================================================================
+!  subroutine GiveAgrif_SpecialValueToTab
+!---------------------------------------------------------------------------------------------------
+subroutine GiveAgrif_SpecialValueToTab ( var1, var2, &
+                                         lower, upper, Value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Variable),      pointer      :: var1
+    TYPE(Agrif_Variable),      pointer      :: var2
+    INTEGER,                   intent(in)   :: nbdim
+    INTEGER, DIMENSION(nbdim), intent(in)   :: lower, upper
+    REAL,                      intent(in)   :: Value
+!
+    select case (nbdim)
+    case (1)
+        where (var1 % array1( lower(1):upper(1)) == Value)
+            var2 % array1(lower(1):upper(1)) = Value
+        end where
+    case (2)
+        where (var1 % array2( lower(1):upper(1), &
+                                   lower(2):upper(2)) == Value)
+            var2 % array2(lower(1):upper(1), &
+                               lower(2):upper(2)) = Value
+        end where
+    case (3)
+        where (var1 % array3( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3)) == Value)
+            var2 % array3(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3)) = Value
+        end where
+    case (4)
+        where (var1 % array4( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4)) == Value)
+            var2 % array4(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4)) = Value
+        end where
+    case (5)
+        where (var1 % array5( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4), &
+                                   lower(5):upper(5)) == Value)
+            var2 % array5(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4), &
+                               lower(5):upper(5)) = Value
+        end where
+    case (6)
+        where (var1 % array6( lower(1):upper(1), &
+                                   lower(2):upper(2), &
+                                   lower(3):upper(3), &
+                                   lower(4):upper(4), &
+                                   lower(5):upper(5), &
+                                   lower(6):upper(6)) == Value)
+            var2 % array6(lower(1):upper(1), &
+                               lower(2):upper(2), &
+                               lower(3):upper(3), &
+                               lower(4):upper(4), &
+                               lower(5):upper(5), &
+                               lower(6):upper(6)) = Value
+        end where
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine GiveAgrif_SpecialValueToTab
+!===================================================================================================
+#endif
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_var_replace_value
+!
+!> Replace \b value by \var2 content in \var1 data array.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_var_replace_value ( var1, var2, lower, upper, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),      intent(inout) :: var1    !< Modified variable
+    type(Agrif_Variable),      intent(in)    :: var2    !< Input variable
+    integer, dimension(nbdim), intent(in)    :: lower   !< Lower bound
+    integer, dimension(nbdim), intent(in)    :: upper   !< Upper bound
+    real,                      intent(in)    :: value   !< Special value
+    integer,                   intent(in)    :: nbdim   !< Dimension of the array
+!
+    integer :: i,j,k,l,m,n
+!
+    select case (nbdim)
+    case (1)
+        do i = lower(1),upper(1)
+            if (var1%array1(i) == value) then
+                var1%array1(i) = var2%array1(i)
+            endif
+        enddo
+    case (2)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array2(i,j) == value) then
+                var1%array2(i,j) = var2%array2(i,j)
+            endif
+        enddo
+        enddo
+    case (3)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array3(i,j,k) == value) then
+                var1%array3(i,j,k) = var2%array3(i,j,k)
+            endif
+        enddo
+        enddo
+        enddo
+    case (4)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array4(i,j,k,l) == value) then
+                var1%array4(i,j,k,l) = var2%array4(i,j,k,l)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+    case (5)
+        do m = lower(5),upper(5)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array5(i,j,k,l,m) == value) then
+                var1%array5(i,j,k,l,m) = var2%array5(i,j,k,l,m)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    case (6)
+        do n = lower(6),upper(6)
+        do m = lower(5),upper(5)
+        do l = lower(4),upper(4)
+        do k = lower(3),upper(3)
+        do j = lower(2),upper(2)
+        do i = lower(1),upper(1)
+            if (var1%array6(i,j,k,l,m,n) == value) then
+                var1%array6(i,j,k,l,m,n) = var2%array6(i,j,k,l,m,n)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_var_replace_value
+!===================================================================================================
+#endif
+!
+!===================================================================================================
+!  subroutine PreProcessToInterpOrUpdate
+!---------------------------------------------------------------------------------------------------
+subroutine PreProcessToInterpOrUpdate ( parent, child,              &
+                                        nb_child, ub_child,         &
+                                        lb_child, lb_parent,        &
+                                        s_child,  s_parent,         &
+                                        ds_child, ds_parent, nbdim, interp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer, intent(in)   :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer, intent(in)   :: child        !< Variable on the child grid
+    integer, dimension(6), intent(out)          :: nb_child     !< Number of cells on the child grid
+    integer, dimension(6), intent(out)          :: ub_child     !< Upper bound on the child grid
+    integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid
+    integer, dimension(6), intent(out)          :: lb_parent    !< Lower bound on the parent grid
+    real, dimension(6),    intent(out)          :: s_child      !< Child  grid position (s_root = 0)
+    real, dimension(6),    intent(out)          :: s_parent     !< Parent grid position (s_root = 0)
+    real, dimension(6),    intent(out)          :: ds_child     !< Child  grid dx (ds_root = 1)
+    real, dimension(6),    intent(out)          :: ds_parent    !< Parent grid dx (ds_root = 1)
+    integer,               intent(out)          :: nbdim        !< Number of dimensions
+    logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n
+                                                                !! .false. if preprocess for update
+!
+    type(Agrif_Variable), pointer :: root_var
+    type(Agrif_Grid),     pointer :: Agrif_Child_Gr
+    type(Agrif_Grid),     pointer :: Agrif_Parent_Gr
+    integer :: n
+!
+    Agrif_Child_Gr  => Agrif_Curgrid
+    Agrif_Parent_Gr => Agrif_Curgrid % parent
+!
+    root_var => child % root_var
+!
+!   Number of dimensions of the current grid
+    nbdim = root_var % nbdim
+!
+    do n = 1,nbdim
+!
+!       Value of interptab(n) can be either x,y,z or N for a no space dimension
+        select case(root_var % interptab(n))
+!
+        case('x')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(1)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(1)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(1)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(1)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1)
+!
+            if ( root_var % posvar(n) == 1 ) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('y')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(2)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(2)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(2)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(2)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2)
+!
+            if (root_var % posvar(n)==1) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('z')
+!
+            lb_child(n)  = root_var % point(n)
+            lb_parent(n) = root_var % point(n)
+            nb_child(n)  = Agrif_Child_Gr % nb(3)
+            s_child(n)   = Agrif_Child_Gr  % Agrif_x(3)
+            s_parent(n)  = Agrif_Parent_Gr % Agrif_x(3)
+            ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(3)
+            ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3)
+!
+            if (root_var % posvar(n)==1) then
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3)
+            else
+                ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3) - 1
+                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+            endif
+!
+        case('N') ! No space dimension
+!
+!       The next coefficients are calculated in order to do a simple copy of
+!       values of the grid variable when the interpolation routine is
+!       called for this dimension.
+!
+            if (interp) then
+                call Agrif_get_var_bounds(parent, lb_child(n), ub_child(n), n)
+                nb_child(n) = parent % ub(n) - parent % lb(n)
+            else
+                call Agrif_get_var_bounds(child,  lb_child(n), ub_child(n), n)
+                nb_child(n) = child % ub(n) - child % lb(n)
+            endif
+!
+!           No interpolation but only a copy of the values of the grid variable
+            lb_parent(n) = lb_child(n)
+            s_child(n)   = 0.
+            s_parent(n)  = 0.
+            ds_child(n)  = 1.
+            ds_parent(n) = 1.
+!
+        end select
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PreProcessToInterpOrUpdate
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!   subroutine Agrif_GetLocalBoundaries
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_GetLocalBoundaries ( tab1, tab2, coord, lb, ub, deb, fin )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     ::  tab1
+    integer, intent(in)     ::  tab2
+    integer, intent(in)     ::  coord
+    integer, intent(in)     ::  lb, ub
+    integer, intent(out)    ::  deb, fin
+!
+    integer :: imin, imax
+    integer :: i1, i2
+!
+    call Agrif_InvLoc(lb, AGRIF_ProcRank, coord, imin)
+    call Agrif_InvLoc(ub, AGRIF_ProcRank, coord, imax)
+!
+    if ( imin > tab2 ) then
+        i1 = imax - imin
+    else
+        i1 = max(tab1 - imin,0)
+    endif
+!
+    if (imax < tab1) then
+        i2 = -(imax - imin)
+    else
+        i2 = min(tab2 - imax,0)
+    endif
+!
+    deb = lb + i1
+    fin = ub + i2
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_GetLocalBoundaries
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_GlobalToLocalBounds
+!
+!> For a global index located on the current processor, tabarray gives the corresponding local index
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob,    &
+                                       coords, nbdim, rank, member )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim,2,2), intent(out)   :: locbounds   !< Local values of \b lb_glob and \b ub_glob
+    integer, dimension(nbdim),     intent(in)    :: lb_var      !< Local lower boundary on the current processor
+    integer, dimension(nbdim),     intent(in)    :: ub_var      !< Local upper boundary on the current processor
+    integer, dimension(nbdim),     intent(in)    :: lb_glob     !< Global lower boundary
+    integer, dimension(nbdim),     intent(in)    :: ub_glob     !< Global upper boundary
+    integer, dimension(nbdim),     intent(in)    :: coords
+    integer,                       intent(in)    :: nbdim       !< Dimension of the array
+    integer,                       intent(in)    :: rank        !< Rank of the processor
+    logical,                       intent(out)   :: member
+!
+    integer     :: i, i1, k
+    integer     :: nbloc(nbdim)
+!
+    locbounds(:,1,:) =  HUGE(1)
+    locbounds(:,2,:) = -HUGE(1)
+!
+    nbloc = 0
+!
+    do i = 1,nbdim
+!
+        call Agrif_InvLoc(lb_var(i), rank, coords(i), i1)
+!
+        do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1
+!
+            if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then
+                nbloc(i) = 1
+                locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1)
+                locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1)
+
+                locbounds(i,1,2) = min(locbounds(i,1,2),k)
+                locbounds(i,2,2) = max(locbounds(i,2,2),k)
+            endif
+        enddo
+    enddo
+
+    member = ( sum(nbloc) == nbdim )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_GlobalToLocalBounds
+!===================================================================================================
+#endif
+!
+end module Agrif_Arrays
Index: vendors/AGRIF/AGRIF_FILES/modbc.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modbc.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modbc.F90	(revision 9621)
@@ -0,0 +1,649 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Boundary.
+!>
+!> Contains subroutines to calculate the boundary conditions on the child grids from their
+!> parent grids.
+!
+module Agrif_Boundary
+!
+    use Agrif_Interpolation
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_CorrectVariable
+!
+!> subroutine to calculate the boundary conditions on a fine grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CorrectVariable ( parent, child, pweight, weight, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    logical                             :: pweight      !< Indicates if weight is used for the time interpolation
+    real                                :: weight       !< Coefficient for the time interpolation
+    procedure()                         :: procname     !< Data recovery procedure
+!
+    type(Agrif_Grid)    , pointer :: Agrif_Child_Gr, Agrif_Parent_Gr
+    type(Agrif_Variable), pointer :: root_var   ! Variable on the root grid
+    integer                :: nbdim  ! Number of dimensions of the grid variable
+    integer                :: n
+    integer, dimension(6)  :: lb_child       ! Index of the first point inside the domain for
+                                                !    the child grid variable
+    integer, dimension(6)  :: lb_parent      ! Index of the first point inside the domain for
+                                                !    the parent grid variable
+    integer, dimension(6)  :: ub_child     !  Upper bound on the child grid
+    integer, dimension(6)  :: nb_child       ! Number of cells for child
+    integer, dimension(6)  :: posvartab_child   ! Position of the variable on the cell
+    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border
+                                                !    with the root grid
+    real, dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids
+    real, dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.true.)
+    root_var => child % root_var
+    Agrif_Child_Gr => Agrif_Curgrid
+    Agrif_Parent_Gr => Agrif_Curgrid % parent
+!
+    loctab_child(:) = 0
+    posvartab_child(1:nbdim) = root_var % posvar(1:nbdim)
+!
+    do n = 1,nbdim
+!
+        select case(root_var % interptab(n))
+!
+        case('x') ! x DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(1))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(1))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(1)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3
+!
+        case('y') ! y DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(2))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(2))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(2)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3
+!
+        case('z') ! z DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(3))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(3))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(3)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3
+!
+        case('N') ! No space DIMENSION
+!
+            posvartab_child(n) = 1
+            loctab_child(n) = -3
+!
+        end select
+!
+    enddo
+!
+    call Agrif_Correctnd(parent, child, pweight, weight,                    &
+                         lb_child(1:nbdim), lb_parent(1:nbdim),             &
+                         nb_child(1:nbdim), posvartab_child(1:nbdim),       &
+                         loctab_child(1:nbdim),                             &
+                         s_child(1:nbdim), s_parent(1:nbdim),               &
+                         ds_child(1:nbdim),ds_parent(1:nbdim), nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CorrectVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Correctnd
+!
+!> calculates the boundary conditions for a nD grid variable on a fine grid by using
+!> a space and time interpolations; it is called by the #Agrif_CorrectVariable procedure
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Correctnd ( parent, child, pweight, weight,                        &
+                             pttab_child, pttab_Parent,                             &
+                             nbtab_Child, posvartab_Child, loctab_Child,            &
+                             s_Child, s_Parent, ds_Child, ds_Parent,                &
+                             nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    TYPE(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    TYPE(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    LOGICAL                             :: pweight      !< Indicates if weight is used for the temporal interpolation
+    REAL                                :: weight       !< Coefficient for the temporal interpolation
+    INTEGER, DIMENSION(nbdim)   :: pttab_child          !< Index of the first point inside the domain for the parent grid variable
+    INTEGER, DIMENSION(nbdim)   :: pttab_Parent         !< Index of the first point inside the domain for the child  grid variable
+    INTEGER, DIMENSION(nbdim)   :: nbtab_Child          !< Number of cells of the child grid
+    INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2)
+    INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid
+    REAL   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids
+    REAL   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids
+    INTEGER                             :: nbdim        !< Number of dimensions of the grid variable
+    procedure()                         :: procname     !< Data recovery procedure
+!
+    INTEGER,DIMENSION(6)                :: type_interp     ! Type of interpolation (linear, spline,...)
+    INTEGER,DIMENSION(6,6)              :: type_interp_bc  ! Type of interpolation (linear, spline,...)
+    INTEGER,DIMENSION(nbdim,2,2)        :: childarray
+    INTEGER,DIMENSION(nbdim,2)          :: lubglob
+    INTEGER                             :: kindex       ! Index used for safeguard and time interpolation
+    INTEGER,DIMENSION(nbdim,2,2)        :: indtab       ! Arrays indicating the limits of the child
+    INTEGER,DIMENSION(nbdim,2,2)        :: indtruetab   ! grid variable where boundary conditions are
+    INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated
+    INTEGER,DIMENSION(nbdim)            :: coords
+    INTEGER                             :: i, nb, ndir
+    INTEGER                             :: n, sizetab
+    INTEGER                             :: ibeg, iend
+    INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2
+    REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t)
+#if defined AGRIF_MPI
+!
+    INTEGER, DIMENSION(nbdim)   :: lower, upper
+    INTEGER, DIMENSION(nbdim)   :: ltab, utab
+!
+#endif
+!
+    type_interp_bc = child % root_var % type_interp_bc
+    coords         = child % root_var % coords
+!
+    ibeg = child % bcinf
+    iend = child % bcsup
+!
+    indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim) + ibeg
+    indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( iend - ibeg )
+
+    indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - iend
+    indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - ibeg
+
+    WHERE (posvartab_child(1:nbdim) == 2)
+        indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1
+        indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1
+    END WHERE
+!
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2))
+    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2))
+!
+    do nb = 1,nbdim
+        do ndir = 1,2
+!
+            if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+!
+                do n = 1,2
+                    ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
+                enddo
+!
+                do i = 1,nbdim
+!
+                    if (i /= nb) then
+!
+                        if (loctab_child(i) == -1 .OR. loctab_child(i) == -3) then
+                            ptres(i,1,ndir,nb) = pttab_child(i)
+                        else
+                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+                        endif
+                        if (loctab_child(i) == -2 .OR. loctab_child(i) == -3) then
+                            if (posvartab_child(i) == 1) then
+                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i)
+                            else
+                                ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) - 1
+                            endif
+                        else
+                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+                        endif
+!
+                    endif
+!
+                enddo
+
+!
+#if defined AGRIF_MPI
+                call Agrif_get_var_bounds_array(child,lower,upper,nbdim)
+
+                do i = 1,nbdim
+!
+                    Call Agrif_GetLocalBoundaries(ptres(i,1,ndir,nb), ptres(i,2,ndir,nb),  &
+                                                  coords(i), lower(i), upper(i), ltab(i), utab(i) )
+                    ptres2(i,1,ndir,nb) = max(ltab(i),lower(i))
+                    ptres2(i,2,ndir,nb) = min(utab(i),upper(i))
+                    if ((i == nb) .AND. (ndir == 1)) then
+                        ptres2(i,2,ndir,nb) = max(utab(i),lower(i))
+                    elseif ((i == nb) .AND. (ndir == 2)) then
+                        ptres2(i,1,ndir,nb) = min(ltab(i),upper(i))
+                    endif
+!
+                enddo
+#else
+                ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb)
+#endif
+            endif
+!
+        enddo   ! ndir = 1,2
+    enddo       ! nb = 1,nbdim
+!
+    if ( child % interpIndex /= Agrif_Curgrid % parent % ngridstep .OR. &
+         child % Interpolationshouldbemade ) then
+!
+!     Space interpolation
+!
+        kindex = 1
+!
+        do nb = 1,nbdim
+
+            type_interp = type_interp_bc(nb,:)
+
+            do ndir = 1,2
+!
+                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+!
+                    call Agrif_InterpnD(type_interp, parent, child,             &
+                                        ptres(1:nbdim,1,ndir,nb),               &
+                                        ptres(1:nbdim,2,ndir,nb),               &
+                                        pttab_child(1:nbdim),                   &
+                                        pttab_Parent(1:nbdim),                  &
+                                        s_Child(1:nbdim), s_Parent(1:nbdim),    &
+                                        ds_Child(1:nbdim),ds_Parent(1:nbdim),   &
+                                        NULL(), .FALSE., nbdim,                 &
+                                        childarray,                             &
+                                        child%memberin(nb,ndir), .TRUE., procname, coords(nb), ndir)
+
+                    child % childarray(1:nbdim,:,:,nb,ndir) = childarray
+
+                    if (.not. child%interpolationshouldbemade) then
+!
+!                       Safeguard of the values of the grid variable (at times n and n+1 on the parent grid)
+!
+                        sizetab = 1
+                        do i = 1,nbdim
+                            sizetab = sizetab * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1)
+                        enddo
+
+                        call saveAfterInterp(child,ptres2(:,:,ndir,nb),kindex,sizetab,nbdim)
+!
+                    endif
+!
+                endif
+!
+            enddo   ! ndir = 1,2
+        enddo       ! nb = 1,nbdim
+!
+        child % interpIndex = Agrif_Curgrid % parent % ngridstep
+!
+    endif
+!
+    if (.not. child%interpolationshouldbemade) then
+!
+!       Calculation of the coefficients c1t and c2t for the temporary interpolation
+!
+        if (pweight) then
+            c1t = weight
+        else
+            c1t = (REAL(Agrif_Nbstepint()) + 1.) / Agrif_Rhot()
+        endif
+        c2t = 1. - c1t
+!
+!       Time interpolation
+!
+        kindex = 1
+!
+        do nb = 1,nbdim
+            do ndir = 1,2
+                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+                    Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
+                endif
+            enddo
+        enddo
+!
+    endif
+!
+    do nb = 1,nbdim
+    do ndir = 1,2
+        if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
+            select case(nbdim)
+            case(1)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+
+                call procname(parray1(i1:i2),                               &
+                              i1,i2, .FALSE.,coords(nb),ndir)
+            case(2)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+
+                call procname(parray2(i1:i2,j1:j2),                         &
+                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir)
+            case(3)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+
+                call procname(parray3(i1:i2,j1:j2,k1:k2),                   &
+                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
+            case(4)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+
+                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             &
+                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir)
+            case(5)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+
+                call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2),       &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir)
+            case(6)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+                n1 = child % childarray(6,1,2,nb,ndir)
+                n2 = child % childarray(6,2,2,nb,ndir)
+
+                call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir)
+            end select
+        endif
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Correctnd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine saveAfterInterp
+!
+!> saves the values of the grid variable on the fine grid after the space interpolation
+!---------------------------------------------------------------------------------------------------
+subroutine saveAfterInterp ( child_var, bounds, kindex, newsize, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable),       INTENT(inout)  :: child_var !< The fine grid variable
+    INTEGER, DIMENSION(nbdim,2), INTENT(in)     :: bounds
+    INTEGER,                     INTENT(inout)  :: kindex    !< Index indicating where this safeguard
+                                                             !<     is done on the fine grid
+    INTEGER,                     INTENT(in)     :: newsize
+    INTEGER,                     INTENT(in)     :: nbdim
+!
+    INTEGER     :: ir,jr,kr,lr,mr,nr
+!
+!    Allocation of the array oldvalues2d
+!
+    if (newsize .LE. 0) return
+!
+    Call Agrif_Checksize(child_var,kindex+newsize)
+
+    if (child_var % interpIndex /= Agrif_Curgrid % parent % ngridstep ) then
+        child_var % oldvalues2d(1,kindex:kindex+newsize-1) = &
+        child_var % oldvalues2d(2,kindex:kindex+newsize-1)
+    endif
+
+    SELECT CASE (nbdim)
+    CASE (1)
+!CDIR ALTCODE
+        do ir = bounds(1,1), bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray1(ir)
+            kindex = kindex + 1
+        enddo
+!
+    CASE (2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray2(ir,jr)
+            kindex = kindex + 1
+        enddo
+        enddo
+!
+    CASE (3)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray3(ir,jr,kr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+!
+      CASE (4)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray4(ir,jr,kr,lr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (5)
+        do mr = bounds(5,1),bounds(5,2)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray5(ir,jr,kr,lr,mr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (6)
+        do nr = bounds(6,1),bounds(6,2)
+        do mr = bounds(5,1),bounds(5,2)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            child_var % oldvalues2d(2,kindex) = parray6(ir,jr,kr,lr,mr,nr)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    END SELECT
+!---------------------------------------------------------------------------------------------------
+end subroutine saveAfterInterp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine timeInterpolation
+!
+!> subroutine for a linear time interpolation on the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine timeInterpolation ( child_var, bounds, kindex, c1t, c2t, nbdim )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable)       :: child_var !< The fine grid variable
+    INTEGER, DIMENSION(nbdim,2) :: bounds
+    INTEGER                     :: kindex    !< Index indicating the values of the fine grid got
+                                             !<    before and after the space interpolation and
+                                             !<    used for the time interpolation
+    REAL                        :: c1t, c2t  !< Coefficients for the time interpolation (c2t=1-c1t)
+    INTEGER                     :: nbdim
+!
+    INTEGER :: ir,jr,kr,lr,mr,nr
+!
+    SELECT CASE (nbdim)
+    CASE (1)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray1(ir) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                      c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+!
+    CASE (2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray2(ir,jr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                         c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+!
+    CASE (3)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                            c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+!
+    CASE (4)
+        do lr = bounds(4,1),bounds(4,2)
+        do kr = bounds(3,1),bounds(3,2)
+        do jr = bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir = bounds(1,1),bounds(1,2)
+            parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                               c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (5)
+        do mr=bounds(5,1),bounds(5,2)
+        do lr=bounds(4,1),bounds(4,2)
+        do kr=bounds(3,1),bounds(3,2)
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir=bounds(1,1),bounds(1,2)
+            parray5(ir,jr,kr,lr,mr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                                  c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+!
+    CASE (6)
+        do nr=bounds(6,1),bounds(6,2)
+        do mr=bounds(5,1),bounds(5,2)
+        do lr=bounds(4,1),bounds(4,2)
+        do kr=bounds(3,1),bounds(3,2)
+        do jr=bounds(2,1),bounds(2,2)
+!CDIR ALTCODE
+        do ir=bounds(1,1),bounds(1,2)
+            parray6(ir,jr,kr,lr,mr,nr) = c2t*child_var % oldvalues2d(1,kindex) + &
+                                                     c1t*child_var % oldvalues2d(2,kindex)
+            kindex = kindex + 1
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    END SELECT
+!---------------------------------------------------------------------------------------------------
+end subroutine timeInterpolation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Checksize
+!
+!> subroutine used in the saveAfterInterp procedure to allocate the oldvalues2d array
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Checksize ( child_var, newsize )
+!---------------------------------------------------------------------------------------------------
+    TYPE (Agrif_Variable), INTENT(inout)  :: child_var !< The fine grid variable
+    INTEGER              , INTENT(in)     :: newsize   !< Size of the domains where the boundary
+                                                       !<    conditions are calculated
+!
+    REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array
+!
+    if (.NOT. associated(child_var % oldvalues2d)) then
+!
+        allocate(child_var % oldvalues2d(2,newsize))
+        child_var % oldvalues2d = 0.
+!
+    else
+!
+        if (SIZE(child_var % oldvalues2d,2) < newsize) then
+!
+            allocate(tempoldvalues(2,SIZE(child_var % oldvalues2d,2)))
+            tempoldvalues = child_var % oldvalues2d
+            deallocate(child_var % oldvalues2d)
+            allocate(  child_var % oldvalues2d(2,newsize))
+            child_var % oldvalues2d = 0.
+            child_var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = tempoldvalues(:,:)
+            deallocate(tempoldvalues)
+!
+        endif
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Checksize
+!===================================================================================================
+!
+end module Agrif_Boundary
+
Index: vendors/AGRIF/AGRIF_FILES/modbcfunction.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modbcfunction.F90	(revision 9621)
@@ -0,0 +1,680 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_BcFunction.
+!
+module Agrif_BcFunction
+!
+!     Modules used:
+!
+    use Agrif_Boundary
+    use Agrif_Update
+    use Agrif_Save
+!
+    implicit none
+!
+    interface Agrif_Set_Parent
+        module procedure Agrif_Set_Parent_int,      &
+                         Agrif_Set_Parent_real4,    &
+                         Agrif_Set_Parent_real8
+    end interface
+!
+    interface Agrif_Save_Forrestore
+        module procedure Agrif_Save_Forrestore0d,   &
+                         Agrif_Save_Forrestore2d,   &
+                         Agrif_Save_Forrestore3d,   &
+                         Agrif_Save_Forrestore4d
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_int
+!
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_int(tabvarsindic,value)
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    integer, intent(in)     :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_int
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_real4
+!---------------------------------------------------------------------------------------------------
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real4 ( tabvarsindic, value )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    real(kind=4),intent(in) :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % array0 = value
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % sarray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_real4
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_parent_real8
+!---------------------------------------------------------------------------------------------------
+!> To set the TYPE of the variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real8 ( tabvarsindic, value )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+    real(kind=8),intent(in) :: value        !< input value
+!
+    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % darray0 = value
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_parent_real8
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_bc
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade )
+!---------------------------------------------------------------------------------------------------
+    integer,               intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    integer, dimension(2), intent(in)   :: bcinfsup     !< bcinfsup
+    logical, optional,     intent(in)   :: Interpolationshouldbemade !< interpolation should be made
+!
+    integer                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable),  pointer  :: var
+!
+    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+    else
+        print*,"Agrif_Set_bc : warning indic >= 0 !!!"
+        var => Agrif_Curgrid % tabvars(indic)
+    endif
+
+    if (.not.associated(var)) return ! Grand mother grid case
+!
+    if ( Agrif_Curgrid % fixedrank /= 0 ) then
+        if ( .not.associated(var % oldvalues2D) ) then
+            allocate(var % oldvalues2D(2,1))
+            var % interpIndex = -1
+            var % oldvalues2D = 0.
+        endif
+        if ( present(Interpolationshouldbemade) ) then
+            var % Interpolationshouldbemade = Interpolationshouldbemade
+        endif
+    endif
+!
+    var % bcinf = bcinfsup(1)
+    var % bcsup = bcinfsup(2)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_bc
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_interp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4)
+!---------------------------------------------------------------------------------------------------
+    integer,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    integer, optional, intent(in)   :: interp, interp1, interp2, interp3, interp4
+!
+    integer                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable), pointer   :: var
+!
+    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_interp : warning indic >= 0 !!!"
+        var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    var % type_interp = Agrif_Constant
+!
+    if (present(interp))    var % type_interp    = interp
+    if (present(interp1))   var % type_interp(1) = interp1
+    if (present(interp2))   var % type_interp(2) = interp2
+    if (present(interp3))   var % type_interp(3) = interp3
+    if (present(interp4))   var % type_interp(4) = interp4
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_bcinterp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_bcinterp ( tabvarsindic, interp,   interp1,  interp2,  interp3, interp4, &
+                                              interp11, interp12, interp21, interp22 )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
+    INTEGER, OPTIONAL, intent(in)   :: interp,   interp1,  interp2,  interp3, interp4
+    INTEGER, OPTIONAL, intent(in)   :: interp11, interp12, interp21, interp22
+!
+    INTEGER                         :: indic ! indice of the variable in tabvars
+    TYPE(Agrif_Variable), pointer   :: var
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_bcinterp : warning indic >= 0 !!!"
+        var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    var % type_interp_bc = Agrif_Constant
+!
+    if (present(interp))    var % type_interp_bc      = interp
+    if (present(interp1))   var % type_interp_bc(:,1) = interp1
+    if (present(interp11))  var % type_interp_bc(1,1) = interp11
+    if (present(interp12))  var % type_interp_bc(1,2) = interp12
+    if (present(interp2))   var % type_interp_bc(:,2) = interp2
+    if (present(interp21))  var % type_interp_bc(2,1) = interp21
+    if (present(interp22))  var % type_interp_bc(2,2) = interp22
+    if (present(interp3))   var % type_interp_bc(:,3) = interp3
+    if (present(interp4))   var % type_interp_bc(:,4) = interp4
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_bcinterp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_UpdateType
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, &
+                                                update3, update4, update5 )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,           intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5
+!
+    INTEGER                         :: indic ! indice of the variable in tabvars
+    type(Agrif_Variable),  pointer  :: root_var
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        print*,"Agrif_Set_UpdateType : warning indic >= 0 !!!"
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    root_var % type_update = Agrif_Update_Copy
+    if (present(update))    root_var % type_update    = update
+    if (present(update1))   root_var % type_update(1) = update1
+    if (present(update2))   root_var % type_update(2) = update2
+    if (present(update3))   root_var % type_update(3) = update3
+    if (present(update4))   root_var % type_update(4) = update4
+    if (present(update5))   root_var % type_update(5) = update5
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_UpdateType
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_restore ( tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+!
+    INTEGER :: indic  !  indice of the variable in tabvars
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_restore
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Init_variable ( tabvarsindic, procname )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in)  :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()          :: procname         !< Data recovery procedure
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    call Agrif_Interp_variable(tabvarsindic, procname)
+    call Agrif_Bc_variable(tabvarsindic, procname, 1.)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Bc_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight )
+!---------------------------------------------------------------------------------------------------
+    integer,        intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()                :: procname
+    real, optional, intent(in) :: calledweight
+!
+    real    :: weight
+    logical :: pweight
+    integer :: indic
+    integer :: nbdim
+    type(Agrif_Variable), pointer :: root_var
+    type(Agrif_Variable), pointer :: parent_var
+    type(Agrif_Variable), pointer :: child_var
+    type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if ( present(calledweight) ) then
+        weight  = calledweight
+        pweight = .true.
+    else
+        weight  = 0.
+        pweight = .false.
+    endif
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        parent_var => child_var % parent_var
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Bc_variable : warning indic >= 0 !!!"
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+        root_var   => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    nbdim = root_var % nbdim
+!
+    select case( nbdim )
+    case(1)
+        allocate(parray1(child_var%lb(1):child_var%ub(1)))
+    case(2)
+        allocate(parray2(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2) ))
+    case(3)
+        allocate(parray3(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3) ))
+    case(4)
+        allocate(parray4(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4) ))
+    case(5)
+        allocate(parray5(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4), &
+                         child_var%lb(5):child_var%ub(5) ))
+    case(6)
+        allocate(parray6(child_var%lb(1):child_var%ub(1), &
+                         child_var%lb(2):child_var%ub(2), &
+                         child_var%lb(3):child_var%ub(3), &
+                         child_var%lb(4):child_var%ub(4), &
+                         child_var%lb(5):child_var%ub(5), &
+                         child_var%lb(6):child_var%ub(6) ))
+    end select
+!
+!   Create temporary child variable
+    allocate(child_tmp)
+!
+    child_tmp % root_var => root_var
+    child_tmp % oldvalues2D => child_var % oldvalues2D
+!
+!   Index indicating if a space interpolation is necessary
+    child_tmp % interpIndex =  child_var % interpIndex
+    child_tmp % list_interp => child_var % list_interp
+    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
+!
+    child_tmp % point = child_var % point
+    child_tmp % lb = child_var % lb
+    child_tmp % ub = child_var % ub
+!
+    child_tmp % bcinf = child_var % bcinf
+    child_tmp % bcsup = child_var % bcsup
+!
+    child_tmp % childarray = child_var % childarray
+    child_tmp % memberin   = child_var % memberin
+!
+    call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname)
+!
+    child_var % childarray = child_tmp % childarray
+    child_var % memberin   = child_tmp % memberin
+!
+    child_var % oldvalues2D => child_tmp % oldvalues2D
+    child_var % list_interp => child_tmp % list_interp
+!
+    child_var % interpIndex = child_tmp % interpIndex
+!
+    deallocate(child_tmp)
+!
+    select case( nbdim )
+        case(1); deallocate(parray1)
+        case(2); deallocate(parray2)
+        case(3); deallocate(parray3)
+        case(4); deallocate(parray4)
+        case(5); deallocate(parray5)
+        case(6); deallocate(parray6)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Bc_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_variable ( tabvarsindic, procname )
+!---------------------------------------------------------------------------------------------------
+    integer,     intent(in)     :: tabvarsindic     !< indice of the variable in tabvars
+    procedure()                 :: procname         !< Data recovery procedure
+!
+    integer :: nbdim
+    integer :: indic  ! indice of the variable in tabvars
+    logical :: torestore
+    type(Agrif_Variable), pointer   :: root_var
+    type(Agrif_Variable), pointer   :: parent_var       ! Variable on the parent grid
+    type(Agrif_Variable), pointer   :: child_var        ! Variable on the parent grid
+    type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid
+!
+    if ( Agrif_Curgrid%level <= 0 ) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        parent_var => child_var % parent_var
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Interp_variable : warning indic >= 0 !!!"
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+        root_var   => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    nbdim     = root_var % nbdim
+    torestore = root_var % restore
+!
+    allocate(child_tmp)
+!
+    child_tmp % root_var => root_var
+    child_tmp % nbdim = root_var % nbdim
+    child_tmp % point = child_var % point
+    child_tmp % lb = child_var % lb
+    child_tmp % ub = child_var % ub
+    child_tmp % interpIndex =  child_var % interpIndex
+    child_tmp % list_interp => child_var % list_interp
+    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
+!
+    if ( torestore ) then
+        select case( nbdim )
+        case(1)
+            parray1 = child_var % array1
+            child_tmp % restore1D => child_var % restore1D
+        case(2)
+            parray2 = child_var % array2
+            child_tmp % restore2D => child_var % restore2D
+        case(3)
+            parray3 = child_var % array3
+            child_tmp % restore3D => child_var % restore3D
+        case(4)
+            parray4 = child_var % array4
+            child_tmp % restore4D => child_var % restore4D
+        case(5)
+            parray5 = child_var % array5
+            child_tmp % restore5D => child_var % restore5D
+        case(6)
+            parray6 = child_var % array6
+            child_tmp % restore6D => child_var % restore6D
+        end select
+    endif
+!
+    call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname)
+!
+    child_var % list_interp => child_tmp % list_interp
+!
+    deallocate(child_tmp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_Variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_Variable ( tabvarsindic, procname, &
+                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 )
+!---------------------------------------------------------------------------------------------------
+    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars
+    procedure()                                 :: procname         !< Data recovery procedure
+    integer, dimension(2), intent(in), optional :: locupdate
+    integer, dimension(2), intent(in), optional :: locupdate1
+    integer, dimension(2), intent(in), optional :: locupdate2
+    integer, dimension(2), intent(in), optional :: locupdate3
+    integer, dimension(2), intent(in), optional :: locupdate4
+!---------------------------------------------------------------------------------------------------
+    integer :: indic
+    integer :: nbdim
+    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated
+    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated
+    type(Agrif_Variable), pointer   :: root_var
+    type(Agrif_Variable), pointer   :: parent_var
+    type(Agrif_Variable), pointer   :: child_var
+!
+    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return
+    if (agrif_curgrid%grand_mother_grid) return
+!
+    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+!
+    if (indic <= 0) then
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid, -indic)
+        parent_var => child_var % parent_var
+
+        if (.not.associated(parent_var)) then
+          ! can occur during the first update of Agrif_Coarsegrid (if any)
+          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, -indic)
+          child_var % parent_var => parent_var
+        endif
+
+        root_var   => child_var % root_var
+    else
+        print*,"Agrif_Update_Variable : warning indic >= 0 !!!"
+        root_var   => Agrif_Mygrid  % tabvars(indic)
+        child_var  => Agrif_Curgrid % tabvars(indic)
+        parent_var => Agrif_Curgrid % parent % tabvars(indic)
+    endif
+!
+    nbdim = root_var % nbdim
+!
+    updateinf = -99
+    updatesup = -99
+!
+    if ( present(locupdate) ) then
+        updateinf(1:nbdim) = locupdate(1)
+        updatesup(1:nbdim) = locupdate(2)
+    endif
+!
+    if ( present(locupdate1) ) then
+        updateinf(1) = locupdate1(1)
+        updatesup(1) = locupdate1(2)
+    endif
+!
+    if ( present(locupdate2) ) then
+        updateinf(2) = locupdate2(1)
+        updatesup(2) = locupdate2(2)
+    endif
+
+    if ( present(locupdate3) ) then
+        updateinf(3) = locupdate3(1)
+        updatesup(3) = locupdate3(2)
+    endif
+
+    if ( present(locupdate4) ) then
+        updateinf(4) = locupdate4(1)
+        updatesup(4) = locupdate4(2)
+    endif
+!
+    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_Variable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore0D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: tabvarsindic0, tabvarsindic
+!
+    type(Agrif_Variable), pointer   :: root_var, save_var
+    integer :: nbdim
+!
+    root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
+    save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
+    nbdim =  root_var % nbdim
+!
+    select case(nbdim)
+        case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic)
+        case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic)
+        case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic)
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore0D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore2D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:), intent(in)        :: q
+    integer,              intent(in)        :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if ( .not.allocated(save_var%array2) ) then
+        allocate(save_var%array2(save_var%lb(1):save_var%ub(1),  &
+                                 save_var%lb(2):save_var%ub(2)))
+    endif
+!
+    save_var % array2  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore2D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore3D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:), intent(in)      :: q
+    integer,                intent(in)      :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if ( .not.allocated(save_var%array3) ) then
+        allocate(save_var%array3(save_var%lb(1):save_var%ub(1), &
+                                 save_var%lb(2):save_var%ub(2), &
+                                 save_var%lb(3):save_var%ub(3)))
+    endif
+!
+    save_var % array3  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore3D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_ForRestore4D
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:), intent(in)    :: q
+    integer,                  intent(in)    :: tabvarsindic
+!
+    type(Agrif_Variable),  pointer  :: root_var, save_var
+    integer                         :: indic
+!
+    indic = tabvarsindic
+    if (tabvarsindic >= 0) then
+        if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then
+            indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
+        endif
+    endif
+!
+    if (indic <= 0) then
+        save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
+    else
+        save_var => Agrif_Curgrid % tabvars(indic)
+        root_var => Agrif_Mygrid % tabvars(indic)
+    endif
+!
+    if (.not.allocated(save_var%array4)) then
+        allocate(save_var%array4(save_var%lb(1):save_var%ub(1),&
+                                 save_var%lb(2):save_var%ub(2),&
+                                 save_var%lb(3):save_var%ub(3),&
+                                 save_var%lb(4):save_var%ub(4)))
+    endif
+!
+    save_var % array4  = q
+    root_var % restore = .true.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_ForRestore4D
+!===================================================================================================
+!
+end module Agrif_BcFunction
Index: vendors/AGRIF/AGRIF_FILES/modcluster.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modcluster.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modcluster.F90	(revision 9621)
@@ -0,0 +1,1277 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Clustering
+!>
+!> Contains subroutines to create and initialize the grid hierarchy from the
+!> AGRIF_FixedGrids.in file.
+!
+module Agrif_Clustering
+!
+    use Agrif_CurgridFunctions
+    use Agrif_Init_Vars
+    use Agrif_Save
+!
+    implicit none
+!
+    abstract interface
+        subroutine init_proc()
+        end subroutine init_proc
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Cluster_All
+!
+!> Subroutine for the clustering. A temporary grid hierarchy, pointed by parent_rect, is created.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Cluster_All ( g, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer   :: g        !< Pointer on the current grid
+    TYPE(Agrif_Rectangle), pointer   :: parent_rect
+!
+    TYPE(Agrif_LRectangle), pointer  :: parcours
+    TYPE(Agrif_Grid)      , pointer  :: newgrid
+    REAL                             :: g_eps
+    INTEGER                          :: i
+!
+    g_eps = huge(1.)
+    do i = 1,Agrif_Probdim
+        g_eps = min(g_eps, g % Agrif_dx(i))
+    enddo
+!
+    g_eps = g_eps / 100.
+!
+!   Necessary condition for clustering
+    do i = 1,Agrif_Probdim
+        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps)) return
+    enddo
+!
+    nullify(parent_rect%childgrids)
+!
+    call Agrif_ClusterGridnD(g,parent_rect)
+!
+    parcours => parent_rect % childgrids
+!
+    do while ( associated(parcours) )
+!
+!       Newgrid is created. It is a copy of a fine grid created previously by clustering.
+        allocate(newgrid)
+!
+        do i = 1,Agrif_Probdim
+            newgrid % nb(i) = (parcours % r % imax(i) - parcours % r % imin(i)) * Agrif_Coeffref(i)
+            newgrid % Agrif_x(i)  = g % Agrif_x(i)  + (parcours % r % imin(i) -1) * g%Agrif_dx(i)
+            newgrid % Agrif_dx(i) = g % Agrif_dx(i) / Agrif_Coeffref(i)
+        enddo
+!
+        if ( Agrif_Probdim == 1 ) then
+            allocate(newgrid%tabpoint1D(newgrid%nb(1)+1))
+            newgrid%tabpoint1D = 0
+        endif
+!
+        if ( Agrif_Probdim == 2 ) then
+            allocate(newgrid%tabpoint2D(newgrid%nb(1)+1, newgrid%nb(2)+1))
+            newgrid%tabpoint2D = 0
+        endif
+!
+        if ( Agrif_Probdim == 3 ) then
+            allocate(newgrid%tabpoint3D(newgrid%nb(1)+1, newgrid%nb(2)+1, newgrid%nb(3)+1))
+            newgrid%tabpoint3D = 0
+        endif
+!
+!       Points detection on newgrid
+        call Agrif_TabpointsnD(Agrif_mygrid,newgrid)
+!
+!       recursive call to Agrif_Cluster_All
+        call Agrif_Cluster_All(newgrid, parcours % r)
+!
+        parcours => parcours % next
+!
+        if ( Agrif_Probdim == 1 ) deallocate(newgrid%tabpoint1D)
+        if ( Agrif_Probdim == 2 ) deallocate(newgrid%tabpoint2D)
+        if ( Agrif_Probdim == 3 ) deallocate(newgrid%tabpoint3D)
+!
+        deallocate(newgrid)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Cluster_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_TabpointsnD
+!
+!> Copy on newgrid of points detected on the grid hierarchy pointed by g.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_TabpointsnD ( g, newgrid )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer   :: g, newgrid
+!
+    TYPE(Agrif_PGrid), pointer  :: parcours
+!
+    REAL                  :: g_eps, newgrid_eps, eps
+    REAL   , DIMENSION(3) :: newmin, newmax
+    REAL   , DIMENSION(3) :: gmin, gmax
+    REAL   , DIMENSION(3) :: xmin
+    INTEGER, DIMENSION(3) :: igmin, inewmin
+    INTEGER, DIMENSION(3) :: inewmax
+    INTEGER               :: i,  j,  k
+    INTEGER               :: i0, j0, k0
+!
+    parcours => g % child_list % first
+!
+    do while( associated(parcours) )
+        call Agrif_TabpointsnD(parcours%gr,newgrid)
+        parcours => parcours % next
+    enddo
+!
+    g_eps = 10.
+    newgrid_eps = 10.
+!
+    do i = 1,Agrif_probdim
+        g_eps = min( g_eps , g % Agrif_dx(i) )
+        newgrid_eps = min(newgrid_eps,newgrid%Agrif_dx(i))
+    enddo
+!
+    eps = min(g_eps,newgrid_eps)/100.
+!
+    do i = 1,Agrif_probdim
+!
+         if ( newgrid%Agrif_dx(i) < (g%Agrif_dx(i)-eps) ) return
+!
+         gmin(i) = g%Agrif_x(i)
+         gmax(i) = g%Agrif_x(i) + g%nb(i) * g%Agrif_dx(i)
+!
+         newmin(i) = newgrid%Agrif_x(i)
+         newmax(i) = newgrid%Agrif_x(i) + newgrid%nb(i) * newgrid%Agrif_dx(i)
+!
+         if (gmax(i) < newmin(i)) return
+         if (gmin(i) > newmax(i)) return
+!
+         inewmin(i) = 1 - floor(-(max(gmin(i),newmin(i))-newmin(i)) / newgrid%Agrif_dx(i))
+!
+         xmin(i) = newgrid%Agrif_x(i) + (inewmin(i)-1)*newgrid%Agrif_dx(i)
+!
+         igmin(i) = 1 + nint((xmin(i)-gmin(i))/g%Agrif_dx(i))
+!
+         inewmax(i) = 1 + int(   (min(gmax(i),newmax(i))-newmin(i)) / newgrid%Agrif_dx(i))
+!
+    enddo
+!
+    if ( Agrif_probdim == 1 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            newgrid%tabpoint1D(i) = max( newgrid%tabpoint1D(i), g%tabpoint1D(i0) )
+        enddo
+        i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+    endif
+!
+    if ( Agrif_probdim == 2 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+                newgrid%tabpoint2D(i,j) = max( newgrid%tabpoint2D(i,j), g%tabpoint2D(i0,j0) )
+                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+        enddo
+    endif
+!
+    if ( Agrif_probdim == 3 ) then
+        i0 = igmin(1)
+        do i = inewmin(1),inewmax(1)
+            j0 = igmin(2)
+            do j = inewmin(2),inewmax(2)
+                k0 = igmin(3)
+                do k = inewmin(3),inewmax(3)
+                    newgrid%tabpoint3D(i,j,k) = max( newgrid%tabpoint3D(i,j,k), g%tabpoint3D(i0,j0,k0))
+                    k0 = k0 + int(newgrid%Agrif_dx(3)/g%Agrif_dx(3))
+                enddo
+                j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2))
+            enddo
+            i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1))
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_TabpointsnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ClusterGridnD
+!
+!> Clustering on the grid pointed by g.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ClusterGridnD ( g, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer  :: g          !< Pointer on the current grid
+    TYPE(Agrif_Rectangle), pointer  :: parent_rect
+!
+    TYPE(Agrif_Rectangle) :: newrect
+    TYPE(Agrif_Variable_i)  :: newflag
+!
+    INTEGER               :: i,j,k
+    INTEGER, DIMENSION(3) :: sx
+    INTEGER               :: bufferwidth,flagpoints
+    INTEGER               :: n1,n2,m1,m2,o1,o2
+!
+    bufferwidth = int(Agrif_Minwidth/5.)
+!
+    do i = 1,Agrif_probdim
+        sx(i) = g % nb(i) + 1
+    enddo
+!
+    if ( Agrif_probdim == 1 ) then
+        allocate(newflag%iarray1(sx(1)))
+        newflag%iarray1 = 0
+    endif
+    if ( Agrif_probdim == 2 ) then
+        allocate(newflag%iarray2(sx(1),sx(2)))
+        newflag%iarray2 = 0
+    endif
+    if ( Agrif_probdim == 3 ) then
+        allocate(newflag%iarray3(sx(1),sx(2),sx(3)))
+        newflag%iarray3 = 0
+    endif
+!
+    flagpoints = 0
+!
+    if ( bufferwidth>0 ) then
+!
+        if ( Agrif_probdim == 1 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+                if (g % tabpoint1D(i) == 1) then
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray1(m1:m2) = 1
+                endif
+            enddo
+        endif
+!
+        if ( Agrif_probdim == 2 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+            do j = bufferwidth,sx(2)-bufferwidth+1
+                if (g % tabpoint2D(i,j) == 1) then
+                    n1 = j - bufferwidth + 1
+                    n2 = j + bufferwidth - 1
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray2(m1:m2,n1:n2) = 1
+                endif
+            enddo
+            enddo
+        endif
+!
+        if ( Agrif_probdim == 3 ) then
+            do i = bufferwidth,sx(1)-bufferwidth+1
+            do j = bufferwidth,sx(2)-bufferwidth+1
+            do k = bufferwidth,sx(3)-bufferwidth+1
+                if (g % tabpoint3D(i,j,k) == 1) then
+                    o1 = k - bufferwidth + 1
+                    o2 = k + bufferwidth - 1
+                    n1 = j - bufferwidth + 1
+                    n2 = j + bufferwidth - 1
+                    m1 = i - bufferwidth + 1
+                    m2 = i + bufferwidth - 1
+                    flagpoints = flagpoints + 1
+                    newflag%iarray3(m1:m2,n1:n2,o1:o2) = 1
+                endif
+            enddo
+            enddo
+            enddo
+        endif
+!
+    else
+!
+        flagpoints = 1
+        if ( Agrif_probdim == 1 ) newflag%iarray1 = g % tabpoint1D
+        if ( Agrif_probdim == 2 ) newflag%iarray2 = g % tabpoint2D
+        if ( Agrif_probdim == 3 ) newflag%iarray3 = g % tabpoint3D
+!
+    endif
+!
+    if (flagpoints == 0) then
+        if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
+        if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
+        if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
+        return
+    endif
+!
+    do i = 1 , Agrif_probdim
+        newrect % imin(i) = 1
+        newrect % imax(i) = sx(i)
+    enddo
+!
+    call Agrif_Clusternd(newflag,parent_rect%childgrids,newrect)
+!
+    if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1)
+    if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2)
+    if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ClusterGridnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ClusternD
+!
+!> Clustering on the grid pointed by oldB.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Clusternd ( flag, boxlib, oldB )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Variable_i)            :: flag
+    TYPE(Agrif_LRectangle), pointer :: boxlib
+    TYPE(Agrif_Rectangle)           :: oldB
+!
+    TYPE(Agrif_LRectangle),pointer :: tempbox,parcbox,parcbox2
+    TYPE(Agrif_Rectangle) :: newB,newB2
+    INTEGER :: i,j,k
+    INTEGER, DIMENSION(:), allocatable :: i_sig, j_sig, k_sig
+    INTEGER, DIMENSION(3) :: ipu,ipl
+    INTEGER, DIMENSION(3) :: istr,islice
+    REAL :: cureff, neweff
+    INTEGER :: ValMax,ValSum,TailleTab
+    INTEGER :: nbpoints,nbpointsflag
+    LOGICAL :: test
+!
+                              allocate( i_sig(oldB%imin(1):oldB%imax(1)) )
+    if ( Agrif_probdim >= 2 ) allocate( j_sig(oldB%imin(2):oldB%imax(2)) )
+    if ( Agrif_probdim == 3 ) allocate( k_sig(oldB%imin(3):oldB%imax(3)) )
+!
+    test = .FALSE.
+    do i = 1,Agrif_probdim
+        test = test .OR. ( (oldB%imax(i)-oldB%imin(i)+1) <  Agrif_Minwidth)
+    enddo
+    if ( test ) return
+!
+    if ( Agrif_probdim == 1 ) i_sig = flag%iarray1
+    if ( Agrif_probdim == 2 ) then
+        do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray2(i, oldB%imin(2):oldB%imax(2)))
+        enddo
+        do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray2(oldB%imin(1):oldB%imax(1),j))
+        enddo
+    endif
+    if ( Agrif_probdim == 3 ) then
+        do i = oldB%imin(1),oldB%imax(1)
+            i_sig(i) = SUM(flag%iarray3(i,oldB%imin(2):oldB%imax(2),    &
+                                          oldB%imin(3):oldB%imax(3)))
+        enddo
+        do j = oldB%imin(2),oldB%imax(2)
+            j_sig(j) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1), j, &
+                                          oldB%imin(3):oldB%imax(3)))
+        enddo
+        do k = oldB%imin(3),oldB%imax(3)
+            k_sig(k) = SUM(flag%iarray3(  oldB%imin(1):oldB%imax(1),    &
+                                          oldB%imin(2):oldB%imax(2), k) )
+        enddo
+    endif
+!
+    do i = 1,Agrif_probdim
+        ipl(i) = oldB%imin(i)
+        ipu(i) = oldB%imax(i)
+    enddo
+!
+                              call Agrif_Clusterprune(i_sig,ipl(1),ipu(1))
+    if ( Agrif_probdim >= 2 ) call Agrif_Clusterprune(j_sig,ipl(2),ipu(2))
+    if ( Agrif_probdim == 3 ) call Agrif_Clusterprune(k_sig,ipl(3),ipu(3))
+!
+    test = .TRUE.
+    do i = 1,Agrif_probdim
+        test = test .AND. (ipl(i) == oldB%imin(i))
+        test = test .AND. (ipu(i) == oldB%imax(i))
+    enddo
+
+    if (.NOT. test) then
+        do i = 1 , Agrif_probdim
+            newB%imin(i) = ipl(i)
+            newB%imax(i) = ipu(i)
+        enddo
+!
+        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2),    &
+                                                              newB%imin(3):newB%imax(3)))
+!
+        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1)
+        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1) * &
+                                              (newB%imax(3)-newB%imin(3)+1)
+        neweff = REAL(nbpoints) / TailleTab
+!
+        if (nbpoints > 0) then
+!
+            if ((neweff > Agrif_efficiency)) then
+                call Agrif_Add_Rectangle(newB,boxlib)
+                return
+            else
+!
+                tempbox => boxlib
+                newB2 = newB
+                call Agrif_Clusternd(flag,boxlib,newB)
+!
+!               Compute new efficiency
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+!
+                do while (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) exit
+                    newB = parcbox2%r
+!
+                    if ( Agrif_probdim == 1 ) Valsum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim == 2 ) Valsum = SUM(flag%iarray2(newB%imin(1):newB%imax(1), &
+                                                                        newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim == 3 ) Valsum = SUM(flag%iarray3(newB%imin(1):newB%imax(1), &
+                                                                        newB%imin(2):newB%imax(2), &
+                                                                        newB%imin(3):newB%imax(3)))
+                    nbpointsflag = nbpointsflag + ValSum
+!
+                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1) * &
+                                                          (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next
+                enddo
+!
+! coefficient 1.05 avant 1.15 possibilite de laisser choix a l utilisateur
+                if ( REAL(nbpointsflag)/REAL(nbpoints) < (1.0001*cureff)) then
+                    parcbox2 => boxlib
+                    do while (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next
+                    enddo
+                    boxlib => tempbox
+                    call Agrif_Add_Rectangle(newB2,boxlib)
+                    return
+                endif
+            endif
+        endif
+        return
+    endif
+!
+    do i = 1,Agrif_Probdim
+        istr(i) = oldB%imax(i)
+        islice(i) = oldB%imin(i)
+    enddo
+!
+                              call Agrif_Clusterslice(i_sig,islice(1),istr(1))
+    if ( Agrif_probdim >= 2 ) call Agrif_Clusterslice(j_sig,islice(2),istr(2))
+    if ( Agrif_probdim == 3 ) call Agrif_Clusterslice(k_sig,islice(3),istr(3))
+!
+    ValSum = 0
+    do i = 1,Agrif_Probdim
+        Valsum = valSum + islice(i)
+    enddo
+!
+    if ( Valsum == -Agrif_Probdim ) then
+        call Agrif_Add_Rectangle(oldB,boxlib)
+        return
+    endif
+!
+    nullify(tempbox)
+    tempbox => boxlib
+    if ( Agrif_probdim == 1 ) cureff = (oldB%imax(1)-oldB%imin(1)+1)
+    if ( Agrif_probdim == 2 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
+                                       (oldB%imax(2)-oldB%imin(2)+1)
+    if ( Agrif_probdim == 3 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * &
+                                       (oldB%imax(2)-oldB%imin(2)+1) * &
+                                       (oldB%imax(3)-oldB%imin(3)+1)
+    nullify(parcbox)
+!
+    do i = 1,Agrif_Probdim
+        newB%imax(i) = oldB%imax(i)
+        newB%imin(i) = oldB%imin(i)
+    enddo
+!
+    ValMax = 0
+    do i = 1 , Agrif_Probdim
+        ValMax = Max(ValMax,istr(i))
+    enddo
+!
+    if (istr(1) == ValMax ) then
+        newB%imax(1) = islice(1)
+        call Agrif_Add_Rectangle(newB,parcbox)
+        newB%imin(1) = islice(1)+1
+        newB%imax(1) = oldB%imax(1)
+        call Agrif_Add_Rectangle(newB,parcbox)
+    else if ( Agrif_probdim >= 2 ) then
+        if (istr(2) == ValMax ) then
+            newB%imax(2) = islice(2)
+            call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(2) = islice(2)+1
+            newB%imax(2) = oldB%imax(2)
+            call Agrif_Add_Rectangle(newB,parcbox)
+        else if ( Agrif_probdim == 3 ) then
+            newB%imax(3) = islice(3)
+            call Agrif_Add_Rectangle(newB,parcbox)
+            newB%imin(3) = islice(3)+1
+            newB%imax(3) = oldB%imax(3)
+            call Agrif_Add_Rectangle(newB,parcbox)
+        endif
+    endif
+!
+    do while ( associated(parcbox) )
+        newB = parcbox%r
+!
+        if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+        if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2)))
+        if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1),    &
+                                                              newB%imin(2):newB%imax(2),    &
+                                                              newB%imin(3):newB%imax(3)))
+!
+        if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+        if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1)
+        if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                              (newB%imax(2)-newB%imin(2)+1) * &
+                                              (newB%imax(3)-newB%imin(3)+1)
+        neweff = REAL(nbpoints) / TailleTab
+!
+        if ( nbpoints > 0 ) then
+!
+            if ( (neweff > Agrif_efficiency)) then
+                call Agrif_Add_Rectangle(newB,boxlib)
+            else
+                tempbox => boxlib
+                newB2 = newB
+                call Agrif_Clusternd(flag,boxlib,newB)
+!
+!               Compute new efficiency
+                cureff = neweff
+                parcbox2 => boxlib
+                nbpoints = 0
+                nbpointsflag = 0
+!
+                do while (associated(parcbox2))
+                    if (associated(parcbox2,tempbox)) exit
+                    newB = parcbox2%r
+!
+                    if ( Agrif_probdim == 1 ) ValSum = SUM(flag%iarray1(newB%imin(1):newB%imax(1)))
+                    if ( Agrif_probdim == 2 ) ValSum = SUM(flag%iarray2(newB%imin(1):newB%imax(1),  &
+                                                                        newB%imin(2):newB%imax(2)))
+                    if ( Agrif_probdim == 3 ) ValSum = SUM(flag%iarray3(newB%imin(1):newB%imax(1),  &
+                                                                        newB%imin(2):newB%imax(2),  &
+                                                                        newB%imin(3):newB%imax(3)))
+                    nbpointsflag = nbpointsflag + ValSum
+!
+                    if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1)
+                    if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1)
+                    if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * &
+                                                          (newB%imax(2)-newB%imin(2)+1) * &
+                                                          (newB%imax(3)-newB%imin(3)+1)
+                    nbpoints = nbpoints + TailleTab
+                    parcbox2 => parcbox2%next
+                enddo
+!
+                if  ( REAL(nbpointsflag)/REAL(nbpoints) < (1.15*cureff)) then
+                    parcbox2 => boxlib
+                    do while (associated(parcbox2))
+                        if (associated(parcbox2,tempbox)) exit
+                        deallocate(parcbox2%r)
+                        parcbox2 => parcbox2%next
+                    enddo
+                    boxlib => tempbox
+                    call Agrif_Add_Rectangle(newB2,boxlib)
+                endif
+            endif
+        endif
+        parcbox => parcbox%next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusternd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Clusterslice
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Clusterslice ( sig, slice, str )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,                       intent(inout) :: slice
+    INTEGER,                       intent(inout) :: str
+    INTEGER, DIMENSION(slice:str), intent(in)    :: sig
+!
+    INTEGER                         :: ideb, ifin
+    INTEGER                         :: i, t, a, di, ts
+    INTEGER, DIMENSION(slice:str)   :: lap
+!
+    ideb = slice
+    ifin = str
+!
+    if (SIZE(sig) <= 2*Agrif_Minwidth) then
+        str = -1
+        slice = -1
+        return
+    endif
+!
+    t = -1
+    a = -1
+!
+    do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if (sig(i) == 0) then
+            if ((i-ideb) < (ifin-i)) then
+                di = i - ideb
+            else
+                di = ifin - i
+            endif
+!
+            if (di > t) then
+                a = i
+                t = di
+            endif
+        endif
+    enddo
+!
+    if (a /= -1) then
+        slice = a
+        str = t
+        return
+    endif
+!
+    t = -1
+    a = -1
+!
+    do i = ideb+1,ifin-1
+        lap(i) = sig(i+1) + sig(i-1) - 2*sig(i)
+    enddo
+!
+    do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth
+        if ((lap(i+1)*lap(i)) <= 0) then
+            ts = ABS(lap(i+1) - lap(i))
+            if (ts > t) then
+                t = ts
+                a = i
+            endif
+       endif
+    enddo
+!
+    if (a == (ideb + Agrif_Minwidth - 1)) then
+        a = -1
+        t = -1
+    endif
+!
+    slice = a
+    str = t
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusterslice
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Clusterprune
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Clusterprune ( sig, pl, pu )
+!---------------------------------------------------------------------------------------------------
+    INTEGER,                   intent(inout)    :: pl, pu
+    INTEGER, DIMENSION(pl:pu), intent(in)       :: sig
+!
+    INTEGER :: ideb, ifin
+    INTEGER :: diff, addl, addu, udist, ldist
+!
+    ideb = pl
+    ifin = pu
+!
+    if (SIZE(sig) <= Agrif_Minwidth) return
+!
+    do while ((sig(pl) == 0) .AND. (pl < ifin))
+        pl = pl + 1
+    enddo
+!
+    do while ((sig(pu) == 0) .AND. (pu > ideb))
+        pu = pu - 1
+    enddo
+!
+    if ( (pu-pl) < Agrif_Minwidth ) then
+        diff = Agrif_Minwidth - (pu - pl + 1)
+        udist = ifin - pu
+        ldist = pl - ideb
+        addl = diff / 2
+        addu = diff - addl
+        if (addu > udist) then
+            addu = udist
+            addl = diff - addu
+        endif
+!
+        if (addl > ldist) then
+            addl = ldist
+            addu = diff - addl
+        endif
+!
+        pu = pu + addu
+        pl = pl - addl
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Clusterprune
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Add_Rectangle
+!
+!> Adds the Agrif_Rectangle R in a list managed by LR.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Add_Rectangle ( R, LR )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle)           :: R
+    TYPE(Agrif_LRectangle), pointer :: LR
+!
+    TYPE(Agrif_LRectangle), pointer :: newrect
+!
+    integer                         :: i
+!
+    allocate(newrect)
+    allocate(newrect % r)
+!
+    newrect % r = R
+!
+    do i = 1,Agrif_Probdim
+        newrect % r % spaceref(i) = Agrif_Coeffref(i)
+        newrect % r % timeref(i)  = Agrif_Coeffreft(i)
+    enddo
+!
+    newrect % r % number = -1
+    newrect % next => LR
+    LR => newrect
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Add_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Copy_Rectangle
+!
+!> Creates and returns a copy of Agrif_Rectangle R.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Copy_Rectangle ( R, expand ) result( copy )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle), pointer, intent(in) :: R
+    integer, optional,              intent(in) :: expand
+!
+    TYPE(Agrif_Rectangle), pointer :: copy
+!
+    allocate(copy)
+!
+    copy = R
+    if ( present(expand) ) then
+        copy % imin = copy % imin - expand
+        copy % imax = copy % imax + expand
+    endif
+    copy % childgrids => R % childgrids
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Copy_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Read_Fix_Grd
+!
+!> Creates the grid hierarchy from the reading of the AGRIF_FixedGrids.in file.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Read_Fix_Grd ( parent_rect, j, nunit )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Rectangle), pointer   :: parent_rect !< Pointer on the first grid of the grid hierarchy
+    INTEGER                          :: j          !< Number of the new grid
+    INTEGER                          :: nunit      !< unit associated with file
+!
+    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
+    TYPE(Agrif_LRectangle), pointer  :: parcours   ! Pointer for the recursive procedure
+    TYPE(Agrif_LRectangle), pointer  :: newlrect
+    TYPE(Agrif_LRectangle), pointer  :: end_list
+    INTEGER                          :: i,n        ! for each child grid
+    INTEGER                          :: nb_grids   ! Number of child grids
+!
+!   Reading of the number of child grids
+    read(nunit,*,end=99) nb_grids
+!
+    allocate(end_list)
+!
+    parent_rect % childgrids => end_list
+!
+!   Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and
+!        time refinement factors for each child grid.
+!   Creation and addition of the new grid to the grid hierarchy.
+!
+    do n = 1,nb_grids
+!
+        allocate(newlrect)
+        newrect % number = j   ! Number of the grid
+!
+        if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+            if (Agrif_Probdim == 3) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % imin(3), newrect % imax(3), &
+                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
+                              newrect % timeref(1), newrect % timeref(2), newrect % timeref(3)
+            elseif (Agrif_Probdim == 2) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % spaceref(1), newrect % spaceref(2), &
+                              newrect % timeref(1),  newrect % timeref(2)
+            elseif (Agrif_Probdim == 1) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % spaceref(1), &
+                              newrect % timeref(1)
+            endif
+        else
+            if (Agrif_Probdim == 3) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % imin(3), newrect % imax(3), &
+                              newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), &
+                              newrect % timeref(1)
+            elseif (Agrif_Probdim == 2) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % imin(2), newrect % imax(2), &
+                              newrect % spaceref(1), newrect % spaceref(2), &
+                              newrect % timeref(1)
+            elseif (Agrif_Probdim == 1) then
+                read(nunit,*) newrect % imin(1), newrect % imax(1), &
+                              newrect % spaceref(1), &
+                              newrect % timeref(1)
+            endif
+!
+            if ( Agrif_probdim >= 2 ) then
+                do i = 2,Agrif_probdim
+                    newrect % timeref(i) = newrect % timeref(1)
+                enddo
+            endif
+!
+        endif
+!
+!       Addition to the grid hierarchy
+!
+        j = j + 1
+        allocate(newlrect%r)
+        newlrect % r = newrect
+        end_list % next => newlrect
+        end_list => end_list % next
+!
+    enddo
+!
+    parent_rect % childgrids => parent_rect % childgrids % next
+    parcours => parent_rect % childgrids
+!
+!   recursive operation to create the grid hierarchy branch by branch
+!
+    do while ( associated(parcours) )
+        call Agrif_Read_Fix_Grd(parcours % r, j, nunit)
+        parcours => parcours % next
+    enddo
+99  continue
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Read_Fix_Grd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Create_Grids
+!
+!> Creates the grid hierarchy (g) from the one created with the #Agrif_Read_Fix_Grd or
+!! #Agrif_Cluster_All procedures (parent_rect).
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Create_Grids ( parent_grid, parent_rect )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid)     , pointer  :: parent_grid  !< Pointer on the root coarse grid
+    TYPE(Agrif_Rectangle), pointer  :: parent_rect  !< Pointer on the root coarse grid of the grid hierarchy
+                                                    !!   created with the #Agrif_Read_Fix_Grd subroutine
+!
+    TYPE(Agrif_Grid)      , pointer :: child_grid   ! Newly created child grid
+    TYPE(Agrif_PGrid)     , pointer :: child_grid_p
+    TYPE(Agrif_LRectangle), pointer :: child_rect_p
+    type(Agrif_Rectangle),  pointer :: child_rect
+!
+    INTEGER                         :: i
+    INTEGER, save                   :: moving_grid_id = 0
+!
+    child_rect_p => parent_rect % childgrids
+!
+!   Creation of the grid hierarchy from the one created by using the Agrif_Read_Fix_Grd subroutine
+!
+    do while ( associated(child_rect_p) )
+!
+        child_rect => child_rect_p % r
+!
+        allocate(child_grid)
+!
+!       Pointer on the parent grid
+        child_grid % parent => parent_grid
+        child_grid % rect_in_parent => Agrif_Copy_Rectangle(child_rect_p % r, expand=Agrif_Extra_Boundary_Cells)
+!
+        moving_grid_id = moving_grid_id+1
+        child_grid % grid_id = moving_grid_id
+!
+        do i = 1,Agrif_Probdim
+            child_grid % spaceref(i) = child_rect % spaceref(i)
+            child_grid % timeref(i)  = child_rect % timeref(i)
+            child_grid % nb(i) = (child_rect % imax(i) - child_rect % imin(i)) * child_rect % spaceref(i)
+            child_grid % ix(i) =  child_rect % imin(i)
+            child_grid % Agrif_dt(i) = parent_grid % Agrif_dt(i) / REAL(child_grid % timeref(i))
+            child_grid % Agrif_dx(i) = parent_grid % Agrif_dx(i) / REAL(child_grid % spaceref(i))
+            child_grid % Agrif_x(i)  = parent_grid % Agrif_x(i) + &
+                                            (child_rect % imin(i) - 1) * parent_grid % Agrif_dx(i)
+        enddo
+!
+!       Size of the grid in terms of cpu cost (nx*ny*timeref)
+        child_grid % size = product( child_grid % nb(1:Agrif_Probdim) ) * child_grid % timeref(1)
+!
+!       Level of the current grid
+        child_grid % level = child_grid % parent % level + 1
+        if (child_grid % level > Agrif_MaxLevelLoc) then
+          Agrif_MaxLevelLoc = child_grid%level
+        endif
+!
+!       Number of the grid pointed by child_grid
+        child_grid % fixedrank = child_rect % number
+!
+!       Grid pointed by child_grid is a fixed grid
+        child_grid % fixed = ( child_grid % fixedrank > 0 )
+!
+!       Update the total number of fixed grids
+        if (child_grid % fixed) then
+            Agrif_nbfixedgrids = Agrif_nbfixedgrids + 1
+        endif
+!
+!       Initialize integration counter
+        child_grid % ngridstep = 0
+!
+!       Test indicating if the current grid has a common border with the root
+!       coarse grid in the x direction
+        do i = 1 , Agrif_Probdim
+!
+            child_grid % NearRootBorder(i) = (                  &
+                (child_grid % parent % NearRootBorder(i)) .AND. &
+                (child_grid % ix(i) == 1) )
+!
+            child_grid % DistantRootBorder(i) = (                  &
+                (child_grid % parent % DistantRootBorder(i)) .AND. &
+                (child_grid % ix(i) + (child_grid%nb(i)/child_grid%spaceref(i))-1  == child_grid % parent % nb(i)) )
+        enddo
+!
+!       Writing in output files
+        child_grid % oldgrid = .FALSE.
+!
+#if defined AGRIF_MPI
+        child_grid % communicator = parent_grid % communicator
+#endif
+!
+!       Definition of the characteristics of the variable of the grid pointed by child_grid
+        call Agrif_Create_Var(child_grid)
+!
+!       Addition of this grid to the grid hierarchy
+        call Agrif_gl_append( parent_grid % child_list, child_grid )
+!
+        child_rect_p => child_rect_p % next
+!
+    enddo
+!
+!   Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the grid hierarchy
+!
+    child_grid_p => parent_grid % child_list % first
+    child_rect_p => parent_rect % childgrids
+!
+    do while ( associated(child_rect_p) )
+        call Agrif_Create_Grids( child_grid_p % gr, child_rect_p % r )
+        child_grid_p => child_grid_p % next
+        child_rect_p => child_rect_p % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Create_Grids
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy
+!
+!> Initializes all the grids except the root coarse grid (this one, pointed by Agrif_Types::Agrif_Mygrid, is
+!! initialized by the subroutine Agrif_Util#Agrif_Init_Grids defined in the module Agrif_Util and
+!! called in the main program).
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
+    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    LOGICAL                    :: Init_Hierarchy
+!
+! Initialise the grand mother grid (if any)
+!
+    if ( associated(g, Agrif_Mygrid) .and. agrif_coarse ) then
+        call Agrif_Instance(Agrif_Coarsegrid)
+        call Agrif_Allocation(Agrif_Coarsegrid)
+        call Agrif_initialisations(Agrif_Coarsegrid)
+        call Agrif_InitWorkspace()
+!
+!       Initialization by interpolation (this routine is written by the user)
+        if (present(procname)) Then
+            call procname()
+        else
+            call Agrif_InitValues()
+        endif
+        call Agrif_Instance(Agrif_Mygrid)
+    endif
+
+    parcours => g % child_list % first
+!
+    do while ( associated(parcours) )
+!
+        Init_Hierarchy = .false.
+        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
+                Init_Hierarchy = .true.
+            endif
+        endif
+!
+        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
+        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
+!
+        if (Init_Hierarchy) then
+!
+!           Instanciation of the grid pointed by parcours%gr and its variables
+            call Agrif_Instance(parcours % gr)
+!
+!           Allocation of the arrays containing values of the variables of the
+!           grid pointed by parcours%gr
+!
+            call Agrif_Allocation(parcours % gr)
+            call Agrif_initialisations(parcours % gr)
+!
+            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!               Initialization by copy of the grids created by clustering
+                call Agrif_Allocate_Restore(parcours % gr)
+                call Agrif_CopyFromOld_All(parcours % gr, Agrif_oldmygrid)
+            endif
+!
+!           Initialization by interpolation (this routine is written by the user)
+            call Agrif_InitWorkSpace()
+            if (present(procname)) Then
+                call procname()
+            else
+                call Agrif_InitValues()
+            endif
+!
+            if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+                call Agrif_Free_Restore(parcours % gr)
+            endif
+!
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    parcours => g % child_list % first
+!
+!   recursive operation to initialize all the grids
+    do while ( associated(parcours) )
+        call Agrif_Init_Hierarchy(parcours%gr,procname)
+        parcours => parcours%next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy_Parallel_1
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy_Parallel_1 ( g )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid), pointer       :: g            !< Pointer on the current grid
+!
+    TYPE(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    LOGICAL                    :: Init_Hierarchy
+!
+    parcours => g % child_list % first
+!
+    do while ( associated(parcours) )
+!
+        Init_Hierarchy = .false.
+        if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+            if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then
+                Init_Hierarchy = .true.
+            endif
+        endif
+!
+        if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true.
+        if (parcours % gr % oldgrid)     Init_Hierarchy = .false.
+!
+        if (Init_Hierarchy) then
+!
+!           Instanciation of the grid pointed by parcours%gr and its variables
+            call Agrif_Instance(parcours % gr)
+!
+!           Allocation of the arrays containing values of the variables of the
+!           grid pointed by parcours%gr
+!
+            call Agrif_Allocation(parcours % gr)
+            call Agrif_initialisations(parcours % gr)
+!
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    parcours => g % child_list % first
+!
+!   recursive operation to initialize all the grids
+    do while ( associated(parcours) )
+        call Agrif_Init_Hierarchy_Parallel_1(parcours%gr)
+        parcours => parcours%next
+    enddo
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy_Parallel_1
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Hierarchy_Parallel_2
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Init_Hierarchy_Parallel_2 ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    use Agrif_seq
+!
+    type(Agrif_Grid),     pointer   :: g            !< Pointer on the current grid
+    procedure(init_proc), optional  :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    type(Agrif_PGrid), pointer :: parcours  ! Pointer for the recursive call
+    integer :: is
+!
+    call Agrif_Instance(g)
+    call Agrif_seq_init_sequences( g )
+!
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+        parcours => Agrif_seq_select_child(g,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!     Initialization by interpolation (this routine is written by the user)
+        if (present(procname)) Then
+            call procname()
+        else
+            call Agrif_InitValues()
+        endif
+!
+        call Agrif_Init_ProcList(parcours % gr % proc_def_list, &
+                                 parcours % gr % proc_def_in_parent_list % nitems)
+!
+        call Agrif_Init_Hierarchy_Parallel_2(parcours%gr,procname)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Hierarchy_Parallel_2
+!===================================================================================================
+#endif
+!
+!===================================================================================================
+!  subroutine Agrif_Allocate_Restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Allocate_Restore ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
+!
+    integer :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        if ( Agrif_Mygrid%tabvars(i) % restore ) then
+            if ( Agrif_Gr%tabvars(i) % nbdim == 1 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore1D( &
+                    lbound(Agrif_Gr%tabvars(i)%array1,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array1,1)))
+                Agrif_Gr%tabvars(i)%Restore1D = 0
+            endif
+            if ( Agrif_Gr%tabvars(i) % nbdim == 2 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore2D( &
+                    lbound(Agrif_Gr%tabvars(i)%array2,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array2,1),&
+                    lbound(Agrif_Gr%tabvars(i)%array2,2):&
+                    ubound(Agrif_Gr%tabvars(i)%array2,2)))
+                Agrif_Gr%tabvars(i)%Restore2D = 0
+            endif
+            if ( Agrif_Mygrid%tabvars(i) % nbdim == 3 ) then
+                allocate( Agrif_Gr%tabvars(i)%Restore3D( &
+                    lbound(Agrif_Gr%tabvars(i)%array3,1):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,1),&
+                    lbound(Agrif_Gr%tabvars(i)%array3,2):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,2),&
+                    lbound(Agrif_Gr%tabvars(i)%array3,3):&
+                    ubound(Agrif_Gr%tabvars(i)%array3,3)))
+                Agrif_Gr%tabvars(i)%Restore3D = 0
+            endif
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Allocate_Restore
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_Restore
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_Restore ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid), pointer  :: Agrif_Gr   !< Pointer on the root coarse grid
+!
+    TYPE(Agrif_Variable), pointer :: var
+    integer                       :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+!
+            var = Agrif_Gr % tabvars(i)
+!
+            if (associated(var%Restore1D)) deallocate(var%Restore1D)
+            if (associated(var%Restore2D)) deallocate(var%Restore2D)
+            if (associated(var%Restore3D)) deallocate(var%Restore3D)
+            if (associated(var%Restore4D)) deallocate(var%Restore4D)
+            if (associated(var%Restore5D)) deallocate(var%Restore5D)
+            if (associated(var%Restore6D)) deallocate(var%Restore6D)
+!
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_Restore
+!===================================================================================================
+!
+end module Agrif_Clustering
Index: vendors/AGRIF/AGRIF_FILES/modcurgridfunctions.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modcurgridfunctions.F90	(revision 9621)
@@ -0,0 +1,765 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module to define some procedures concerning the current grid
+!
+module Agrif_CurgridFunctions
+!
+    use Agrif_Init
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  function Agrif_rel_dt
+!
+!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.).
+!---------------------------------------------------------------------------------------------------
+function Agrif_rel_dt ( ) result( rel_dt )
+!---------------------------------------------------------------------------------------------------
+    integer :: i
+    real    :: rel_dt
+!
+    rel_dt = 1.
+!
+    do i = 1,Agrif_Probdim
+        rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_rel_dt
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_rel_idt
+!
+!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1).
+!---------------------------------------------------------------------------------------------------
+function Agrif_rel_idt ( ) result( rel_idt )
+!---------------------------------------------------------------------------------------------------
+    integer :: rel_idt
+!
+    rel_idt = nint(1./Agrif_rel_dt())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_rel_idt
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_IRhot
+!
+!> Returns the time refinement factor of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_IRhot ( ) result( irhot )
+!---------------------------------------------------------------------------------------------------
+    integer :: i, irhot
+!
+    irhot = 1
+!
+    do i = 1,Agrif_Probdim
+        irhot = max(irhot, Agrif_Curgrid % timeref(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_IRhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Rhot
+!
+!> Returns the time refinement factor of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Rhot ( ) result( rhot )
+!---------------------------------------------------------------------------------------------------
+    real    :: rhot
+!
+    rhot = float(Agrif_IRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Rhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_IRhot
+!
+!> Returns the time refinement factor of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_IRhot ( ) result( irhot )
+!---------------------------------------------------------------------------------------------------
+    integer :: i, irhot
+!
+    irhot = 1
+!
+    do i = 1,Agrif_Probdim
+        irhot = max(irhot, Agrif_Curgrid % parent % timeref(i))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_IRhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Rhot
+!
+!> Returns the time refinement factor of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Rhot ( ) result( rhot )
+!---------------------------------------------------------------------------------------------------
+    real :: rhot
+!
+    rhot = float(Agrif_Parent_IRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Rhot
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Nbstepint
+!
+!> function for the calculation of the coefficients used for the time interpolation
+!! (module #Agrif_Boundary).
+!---------------------------------------------------------------------------------------------------
+function Agrif_Nbstepint ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_nbstepint ! result
+!
+    Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot())
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Nbstepint
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Nbstepint
+!
+!> function for the calculation of the coefficients used for the time interpolation
+!! (module #Agrif_Boundary).
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Nbstepint ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Nbstepint ! result
+!
+    Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot()))
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Nbstepint
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderX
+!
+!> Allows to interpolate (in the x direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderX ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(1) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderX
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderX
+!
+!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderX ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(1) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderX
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderY
+!
+!> Allows to interpolate (in the y direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderY ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(2) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderY
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderY
+!
+!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderY ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(2) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderY
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpNearBorderZ
+!
+!> Allows to interpolate (in the z direction) on a near border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpNearBorderZ ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % NearRootBorder(3) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpNearBorderZ
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpDistantBorderZ
+!
+!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one
+!! has a common border with the root coarse grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpDistantBorderZ()
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % DistantRootBorder(3) = .FALSE.
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpDistantBorderZ
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Nb_Step
+!
+!> Returns the number of time steps of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Nb_Step ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Nb_Step ! Result
+!
+    if (Agrif_Root()) then
+        Agrif_Parent_Nb_Step = -1
+    else
+        Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Nb_Step
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Root
+!
+!> Indicates if the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Root ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Root ! Result
+!
+    Agrif_Root = (Agrif_Curgrid % fixedrank == 0)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Root
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_GrandMother
+!
+!> Indicates if the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_GrandMother ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_GrandMother ! Result
+!
+    Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid
+!---------------------------------------------------------------------------------------------------
+end function Agrif_GrandMother
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Root
+!
+!> Indicates if the parent of the current grid is or not the root grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Root ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Parent_Root ! Result
+!
+    Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Root
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Fixed
+!
+!> Returns the number of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Fixed   ! Result
+!
+    if (Agrif_Curgrid % fixed) then
+        Agrif_Fixed = Agrif_Curgrid % fixedrank
+    else
+        Agrif_Fixed = -1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Fixed
+!
+!> Returns the number of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Parent_Fixed   ! Result
+!
+    if (Agrif_Curgrid % parent % fixed) then
+        Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank
+    else
+        Agrif_Parent_Fixed = 0
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Is_Fixed
+!
+!> Returns .TRUE. if the current grid is fixed.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Is_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Is_Fixed   ! Result
+!
+    Agrif_Is_Fixed = Agrif_Curgrid % fixed
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Is_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Parent_Is_Fixed
+!
+!> Returns .TRUE. if the parent of the current grid is fixed.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Parent_Is_Fixed ( )
+!---------------------------------------------------------------------------------------------------
+    logical :: Agrif_Parent_Is_Fixed   ! Result
+!
+    Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Parent_Is_Fixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_CFixed
+!
+!> Returns the number of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_CFixed ( )
+!---------------------------------------------------------------------------------------------------
+    character(3) :: Agrif_CFixed   ! Result
+!
+    character(3) :: cfixed
+    integer      :: fixed
+!
+    fixed = Agrif_Fixed()
+!
+    if (fixed /= -1) then
+!
+        if (fixed <= 9) then
+            write(cfixed,'(i1)') fixed
+        else
+            write(cfixed,'(i2)') fixed
+        endif
+!
+        Agrif_CFixed = cfixed
+        
+        if (associated(agrif_curgrid,agrif_coarsegrid)) then
+          Agrif_CFixed = 'gm'
+        endif
+!
+    else
+        print*,'Call to Agrif_CFixed() on a moving grid'
+        stop
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_CFixed
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrid_Parent_CFixed
+!
+!> Returns the number of the parent of the current grid.
+!---------------------------------------------------------------------------------------------------
+function Agrid_Parent_CFixed ( )
+!---------------------------------------------------------------------------------------------------
+    character(3) :: Agrid_Parent_CFixed   ! Result
+!
+    character(3) :: cfixed
+    integer      :: fixed
+!
+    fixed = Agrif_Parent_Fixed()
+!
+    if(fixed /= -1) then
+!
+        if (fixed <= 9) then
+            write(cfixed,'(i1)')fixed
+        else
+            write(cfixed,'(i2)')fixed
+        endif
+!
+        Agrid_Parent_CFixed=cfixed
+!
+    else
+        print*,'Illegal call to Agrid_Parent_CFixed()'
+        stop
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrid_Parent_CFixed
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ChildGrid_to_ParentGrid
+!
+!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ChildGrid_to_ParentGrid ( )
+!---------------------------------------------------------------------------------------------------
+    Agrif_Curgrid % parent % save_grid => Agrif_Curgrid
+    call Agrif_Instance(Agrif_Curgrid%parent)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ChildGrid_to_ParentGrid
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_ParentGrid_to_ChildGrid
+!
+!> Make the pointer #Agrif_Curgrid point on the child grid after having called the
+!! #Agrif_ChildGrid_to_ParentGrid subroutine.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_ParentGrid_to_ChildGrid ( )
+!---------------------------------------------------------------------------------------------------
+    call Agrif_Instance(Agrif_Curgrid%save_grid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_ParentGrid_to_ChildGrid
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Get_Unit
+!
+!> Returns a unit not connected to any file.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Get_Unit ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Get_Unit  ! Result
+!
+    integer :: n
+    logical :: op
+!
+    integer :: nunit
+    integer :: iii, out, iiimax
+    logical :: bexist
+    integer,dimension(1:1000) :: forbiddenunit
+!
+!   Load forbidden Unit if the file Agrif_forbidenUnit exist
+!
+    INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist)
+!
+    if (.not. bexist) then
+!       File Agrif_forbiddenUnit.txt not found
+    else
+        nunit = 777
+        OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old")
+        iii = 1
+        do while ( .TRUE. )
+            READ(nunit,*, end=99) forbiddenunit(iii)
+            iii = iii + 1
+        enddo
+   99   continue
+        iiimax = iii
+        close(nunit)
+    endif
+!
+    do n = 7,1000
+!
+        INQUIRE(Unit=n,Opened=op)
+!
+        out = 0
+        if ( bexist .AND. (.NOT.op) ) then
+            do iii = 1,iiimax
+                if ( n == forbiddenunit(iii) ) out = 1
+            enddo
+        endif
+!
+        if ( (.NOT.op) .AND. (out == 0) ) exit
+!
+    enddo
+!
+    Agrif_Get_Unit = n
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Get_Unit
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Extra_Boundary_Cells
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: nb_extra_cells
+!
+    Agrif_Extra_Boundary_Cells = nb_extra_cells
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Extra_Boundary_Cells
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Efficiency
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Efficiency ( eff )
+!---------------------------------------------------------------------------------------------------
+    real, intent(in) :: eff
+!
+    if ( (eff < 0.) .OR. (eff > 1) ) then
+        write(*,*) 'Error Efficiency should be between 0 and 1'
+        stop
+    else
+        Agrif_Efficiency = eff
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Efficiency
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Regridding
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Regridding ( regfreq )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: regfreq
+!
+    if (regfreq < 0) then
+        write(*,*) 'Regridding frequency should be positive'
+        stop
+    else
+        Agrif_Regridding = regfreq
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Regridding
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_x
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_x ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+      if (coeffref < 0) then
+         write(*,*) 'Coefficient of raffinement should be positive'
+         stop
+      else
+         Agrif_coeffref(1) = coeffref
+      endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_x
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_y
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_y ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of raffinement should be positive'
+        stop
+    else
+        Agrif_coeffref(2) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_y
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffref_z
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffref_z ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+!
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of raffinement should be positive'
+        stop
+    else
+        Agrif_coeffref(3) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffref_z
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_x
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_x ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(1) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_x
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_y
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_y ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+!
+    if (coeffref < 0) then
+        write(*,*) 'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(2) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_y
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_coeffreft_z
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft_z ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+
+    if (coeffref < 0) then
+        write(*,*)'Coefficient of time raffinement should be positive'
+        stop
+    else
+        Agrif_coeffreft(3) = coeffref
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft_z
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Minwidth
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Minwidth ( coefminwidth )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coefminwidth
+!
+    if (coefminwidth < 0) then
+        write(*,*)'Coefficient of Minwidth should be positive'
+        stop
+    else
+        Agrif_Minwidth = coefminwidth
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Minwidth
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_Rafmax
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_Rafmax ( coefrafmax )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coefrafmax
+!
+    integer :: i
+    real    :: res
+!
+    if (coefrafmax < 0) then
+        write(*,*)'Coefficient of  should be positive'
+        stop
+    else
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(1))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(1) = 1. / res
+!
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(2))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(2) = 1. / res
+!
+        res = 1.
+        do i = 1,coefrafmax-1
+            res = res * FLOAT(Agrif_coeffref(3))
+        enddo
+        if ( res == 0 ) res = 1
+        Agrif_Mind(3) = 1. / res
+!
+      endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_Rafmax
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Set_MaskMaxSearch
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: mymaxsearch
+!
+    MaxSearch = mymaxsearch
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_MaskMaxSearch
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Level
+!---------------------------------------------------------------------------------------------------
+function Agrif_Level ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_Level  ! Result
+!
+    Agrif_Level = Agrif_Curgrid % level
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Level
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_MaxLevel
+!---------------------------------------------------------------------------------------------------
+function Agrif_MaxLevel ( )
+!---------------------------------------------------------------------------------------------------
+    integer :: Agrif_MaxLevel  ! Result
+!
+    Agrif_MaxLevel = Agrif_MaxLevelLoc
+!---------------------------------------------------------------------------------------------------
+end function Agrif_MaxLevel
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_GridAllocation_is_done
+!---------------------------------------------------------------------------------------------------
+function Agrif_GridAllocation_is_done ( ) result(isdone)
+!---------------------------------------------------------------------------------------------------
+    logical :: isdone
+!
+    isdone = Agrif_Curgrid % allocation_is_done
+!---------------------------------------------------------------------------------------------------
+end function Agrif_GridAllocation_is_done
+!===================================================================================================
+!
+end module Agrif_CurgridFunctions
Index: vendors/AGRIF/AGRIF_FILES/modgrids.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modgrids.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modgrids.F90	(revision 9621)
@@ -0,0 +1,478 @@
+module Agrif_Grids
+
+    use Agrif_Types
+!
+    implicit none
+!
+!===================================================================================================
+type Agrif_Grid_List
+!---------------------------------------------------------------------------------------------------
+!<  List of grids.
+!
+    integer                     :: nitems = 0      !< Number of elements in the list
+    type(Agrif_PGrid), pointer  :: first => NULL() !< Pointer to the first grid in the list
+    type(Agrif_PGrid), pointer  :: last  => NULL() !< Pointer to the last  grid inserted in the list
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Grid_List
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_PGrid
+!---------------------------------------------------------------------------------------------------
+!<  Data type to go over the grid hierarchy (used for the creation of this grid hierarchy
+!<  and during the time integration).
+!
+    type(Agrif_Grid) , pointer :: gr   => NULL()  !< Pointer to the actual grid data structure
+    type(Agrif_PGrid), pointer :: next => NULL()  !< Next grid in the list
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_PGrid
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Grid
+!---------------------------------------------------------------------------------------------------
+!<  Data type to define a grid (position, space and time refinement factors).
+!
+    type(Agrif_Grid)                    , pointer :: parent      => NULL() !< pointer on the parent grid
+    type(Agrif_Grid)                    , pointer :: save_grid   => NULL() !< pointer on the save grid
+    type(Agrif_Grid_List)                         :: child_list            !< List of child grids
+    type(Agrif_Variable),   dimension(:), allocatable :: tabvars    !< List of grid variables
+    type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c  !< List of character grid variables
+    type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r  !< List of real      grid variables
+    type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l  !< List of logical   grid variables
+    type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables
+!
+    real   , dimension(3)              :: Agrif_x   !< global x, y and z position
+    real   , dimension(3)              :: Agrif_dx  !< global space step in the x, y and z direction
+    real   , dimension(3)              :: Agrif_dt  !< global time  step in the x, y and z direction
+    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction
+    integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction
+    integer, dimension(3)              :: spaceref  !< space refinement factor in the x, y and z direction
+    integer, dimension(3)              :: timeref   !< Time refinement factor in the x, y and z direction
+    integer                            :: ngridstep !< number of time steps
+    integer                            :: rank
+    integer                            :: grid_id   !< moving grid id
+    integer                            :: fixedrank !< number of the grid
+    logical                            :: fixed     !< fixed or moving grid ?
+    logical                            :: oldgrid
+!> \name Logicals indicating if the current grid has a common border with the root coarse grid
+!> @{
+    logical, dimension(3)              :: NearRootBorder
+    logical, dimension(3)              :: DistantRootBorder
+!> @}
+!> \name Arrays for adaptive grid refinement
+!> @{
+    integer, dimension(:)    ,   allocatable :: tabpoint1D
+    integer, dimension(:,:)  ,   allocatable :: tabpoint2D
+    integer, dimension(:,:,:),   allocatable :: tabpoint3D
+!> @}
+!> \name Members for parallel integration
+!> @{
+    type(Agrif_Rectangle),  pointer    :: rect_in_parent => NULL()
+    type(Agrif_Grid_List)              :: neigh_list                !< List of neighboring grids (ie. connected through a common proc)
+    type(Agrif_Proc_List)              :: proc_def_list             !< List of procs that will integrate this grid
+    type(Agrif_Proc_List)              :: proc_def_in_parent_list   !< List of procs that will integrate this grid (defined as in the parent grid)
+    type(Agrif_Proc_List)              :: required_proc_list        !< List of procs that are required for this grid
+    type(Agrif_Sequence_List), pointer :: child_seq => NULL()       !< Sequence for childs
+    integer                            :: seq_num = 0
+    integer                            :: size = 0
+    integer                            :: dsat = 0
+#if defined AGRIF_MPI
+    integer                            :: communicator = -1
+#endif
+!> @}
+    type(Agrif_Variables_List), pointer :: variables => NULL()
+    integer                             :: NbVariables = 0
+    integer                             :: level    !< level of the grid in the hierarchy
+    logical                             :: allocation_is_done = .false.
+    logical                             :: grand_mother_grid = .false.
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Grid
+!===================================================================================================
+!
+!> this pointer always points on the root grid of the grid hierarchy
+type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL()
+
+!> this pointer always points on the grand mother grid of the grid hierarchy (if any)
+type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL()
+
+!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine.
+!> It contains  the safeguard of the grid hierarchy.
+type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL()
+
+!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
+type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
+!
+!===================================================================================================
+type Agrif_Sequence
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List) :: gridlist
+    type(Agrif_Proc_List) :: proclist
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Sequence
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Sequence_List
+!---------------------------------------------------------------------------------------------------
+    integer :: nb_seqs
+    type(Agrif_Sequence), dimension(:), allocatable :: sequences
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Sequence_List
+!===================================================================================================
+!
+interface
+    function compare_grids ( grid1, grid2 ) result( res )
+        import Agrif_Grid
+        type(Agrif_Grid), intent(in)    :: grid1
+        type(Agrif_Grid), intent(in)    :: grid2
+        integer                         :: res  !< Result of the comparison :
+                                                !!  - res  < 0   if grid1 <  grid2
+                                                !!  - res == 0   if grid1 == grid2
+                                                !!  - res  > 0   if grid1 >  grid2
+    end function compare_grids
+end interface
+!
+contains
+!
+!===================================================================================================
+subroutine Agrif_gl_print ( gridlist )
+!
+!< DEBUG : a virer à terme.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Grid),  pointer  :: grid
+!
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        grid => gridp % gr
+        write(*,'("G",i0,", ")', advance='no') grid % fixedrank
+        gridp => gridp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_print
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_print_debug ( gridlist )
+!
+!< DEBUG : a virer à terme.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Grid),  pointer  :: grid
+!
+    write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        grid => gridp % gr
+        write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, &
+            grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size
+        gridp => gridp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_print_debug
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_append ( gridlist, grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List),     intent(inout)  :: gridlist
+    type(Agrif_Grid), pointer, intent(in)     :: grid
+!
+    type(Agrif_PGrid), pointer   :: new_gp
+!
+    allocate( new_gp )
+!
+    new_gp % gr   => grid
+    new_gp % next => NULL()
+!
+    if ( associated(gridlist % last) ) then
+    ! the list is not empty, append the new pointer at the end
+        gridlist % last % next => new_gp
+    else
+    ! the list is empty, the new pointer is the first one
+        gridlist % first => new_gp
+    endif
+    ! anyway, for next time 'grid' will be the last one.
+    gridlist % last => new_gp
+    gridlist % nitems = gridlist % nitems + 1
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_append
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_popfirst ( gridlist ) result ( grid )
+!
+!<  Removes the first item of the list and returns it.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gridlist
+!
+    type(Agrif_PGrid), pointer :: grid_p
+    type(Agrif_Grid),  pointer :: grid
+!
+    grid_p => gridlist % first
+!
+    if ( .not. associated( grid_p ) ) then
+        grid => NULL()
+        return
+    endif
+!
+    grid              => grid_p % gr
+    gridlist % first  => grid_p % next
+    gridlist % nitems =  gridlist % nitems - 1
+    if ( .not. associated(gridlist % first) ) then
+       nullify(gridlist % last)
+    endif
+    deallocate(grid_p)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_popfirst
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_copy ( new_gl, model )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(out)  :: new_gl
+    type(Agrif_Grid_List), intent(in)   :: model
+!
+    type(Agrif_PGrid), pointer :: gp
+!
+    call Agrif_gl_clear(new_gl)
+    gp => model % first
+!
+    do while( associated(gp) )
+        call Agrif_gl_append( new_gl, gp % gr )
+        gp => gp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_copy
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_build_from_gp ( gridp ) result ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_PGrid), pointer, intent(in)   :: gridp
+!
+    type(Agrif_Grid_List), pointer  :: gridlist
+    type(Agrif_PGrid),     pointer  :: gp
+!
+    allocate(gridlist)
+!
+    gp => gridp
+!
+    do while ( associated( gp ) )
+        call Agrif_gl_append( gridlist, gp % gr )
+        gp => gp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_build_from_gp
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gp_delete ( gridp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_PGrid), pointer, intent(inout)  :: gridp
+!
+    type(Agrif_PGrid), pointer   :: gp, gpd
+!
+    if ( .not. associated( gridp ) ) return
+!
+    gp => gridp
+!
+    do while( associated(gp) )
+        gpd => gp
+        gp  => gp % next
+        deallocate(gpd)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gp_delete
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_clear ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)  :: gridlist
+!
+    call Agrif_gp_delete(gridlist % first)
+    gridlist % first => NULL()
+    gridlist % last  => NULL()
+    gridlist % nitems = 0
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_clear
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_gl_delete ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), pointer, intent(inout)  :: gridlist
+!
+    if ( .not. associated( gridlist ) ) return
+!
+    call Agrif_gp_delete(gridlist % first)
+    deallocate( gridlist )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_gl_delete
+!===================================================================================================
+!
+!===================================================================================================
+recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)    :: gridlist
+    procedure(compare_grids)             :: compare_func
+    procedure(compare_grids), optional   :: compare_func_opt
+!
+    type(Agrif_Grid_List), pointer  :: gl_sorted
+    type(Agrif_Grid_List), pointer  :: gl_left,  gl_sorted_left
+    type(Agrif_Grid_List), pointer  :: gl_right, gl_sorted_right
+    type(Agrif_PGrid),     pointer  :: grid_p
+    integer                         :: n, middle
+!
+! if list size is 1, consider it sorted and return it
+    if  ( (gridlist % nitems <= 1) ) then
+        gl_sorted => Agrif_gl_build_from_gp(gridlist % first)
+        return
+    endif
+!
+! else split the list into two sublists
+    n = 1
+    middle    =  gridlist % nitems / 2
+    grid_p    => gridlist % first
+!
+    allocate( gl_left, gl_right )
+!
+    do while ( associated(grid_p) )
+        if ( n <= middle ) then
+            call Agrif_gl_append(gl_left,  grid_p % gr)
+        else
+            call Agrif_gl_append(gl_right, grid_p % gr)
+        endif
+        grid_p => grid_p % next
+        n = n+1
+    enddo
+!
+! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1
+    gl_sorted_left  => Agrif_gl_merge_sort(gl_left,  compare_func, compare_func_opt)
+    gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt)
+!
+! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist
+    gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt)
+!
+    call Agrif_gl_delete( gl_left )
+    call Agrif_gl_delete( gl_right )
+    call Agrif_gl_delete( gl_sorted_left )
+    call Agrif_gl_delete( gl_sorted_right )
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_merge_sort
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gl_left
+    type(Agrif_Grid_List), intent(inout)    :: gl_right
+    procedure(compare_grids)                :: compare_func
+    procedure(compare_grids), optional      :: compare_func_opt
+!
+    type(Agrif_Grid_List), pointer  :: gl_merged
+    type(Agrif_Grid),      pointer  :: poped_grid
+    integer                         :: comp_value
+!
+    allocate( gl_merged )
+!
+    do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 )
+!
+        if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then
+!
+!         Let.s compare both items with the first compare function
+            comp_value = compare_func( gl_left % first % gr, gl_right % first % gr )
+!
+            if     ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+            elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
+            else ! ( comp_value == 0 )
+!
+!             Both items are equal, let.s use the second criterion if the optional
+!             compare function is present.
+                if ( present(compare_func_opt) ) then
+!
+                    comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr )
+!
+                    if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+                    else                        ; poped_grid => Agrif_gl_popfirst(gl_right)
+                    endif
+                else
+!                 If the second criterion is not present, let.s just pick the left item
+                    poped_grid => Agrif_gl_popfirst(gl_left)
+                endif
+            endif
+!
+!     If one of the lists is empty, we just have to pick in the other one.
+        elseif ( gl_left  % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left)
+        elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right)
+        endif
+!
+        call Agrif_gl_append( gl_merged, poped_grid )
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_gl_merge
+!===================================================================================================
+!
+!===================================================================================================
+function compare_grid_degrees ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems
+!---------------------------------------------------------------------------------------------------
+end function compare_grid_degrees
+!===================================================================================================
+!
+!===================================================================================================
+function compare_colors ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid1 % seq_num - grid2 % seq_num
+!---------------------------------------------------------------------------------------------------
+end function compare_colors
+!===================================================================================================
+!
+!===================================================================================================
+function compare_dsat_values ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % dsat - grid1 % dsat
+!---------------------------------------------------------------------------------------------------
+end function compare_dsat_values
+!===================================================================================================
+!
+!===================================================================================================
+function compare_size_values ( grid1, grid2 ) result( res )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in)    :: grid1
+    type(Agrif_Grid), intent(in)    :: grid2
+!
+    integer     :: res
+!
+    res = grid2 % size - grid1 % size
+!---------------------------------------------------------------------------------------------------
+end function compare_size_values
+!===================================================================================================
+!
+end module Agrif_Grids
Index: vendors/AGRIF/AGRIF_FILES/modinit.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modinit.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modinit.F90	(revision 9621)
@@ -0,0 +1,209 @@
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Init.
+!>
+!> Several operations on the variables of the current grid (creation, instanciation, ...)
+!! used during the creation of the grid hierarchy and during the time integration.
+!
+module Agrif_Init
+!
+    use Agrif_Grids
+    use Agrif_Link
+    use Agrif_Mpp
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Allocation
+!
+!> Allocates the arrays containing the values of the variables of the current grd.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Allocation ( Agrif_Gr, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),       pointer   :: Agrif_Gr   !< Pointer on the current grid
+    procedure(alloc_proc),  optional  :: procname   !< Allocation procedure (Default: Agrif_Allocationcalls)
+!
+    if ( present(procname) ) then
+        call procname(Agrif_Gr)
+    else
+        call Agrif_Allocationcalls(Agrif_Gr)
+    endif
+    Agrif_Gr % allocation_is_done = .true.
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!
+        if ( Agrif_Probdim == 1 ) allocate( Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1) )
+        if ( Agrif_Probdim == 2 ) allocate( Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1, &
+                                                                Agrif_Gr%nb(2)+1) )
+        if ( Agrif_Probdim == 3 ) allocate( Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1, &
+                                                                Agrif_Gr%nb(2)+1, &
+                                                                Agrif_Gr%nb(3)+1) )
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Allocation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Instance
+!
+!> Make the pointer Agrif_Types::Agrif_Curgrid point to Agrif_Gr
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Instance ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+!
+    Agrif_Curgrid => Agrif_Gr
+    Agrif_tabvars => Agrif_Curgrid % tabvars
+    Agrif_tabvars_c => Agrif_Curgrid % tabvars_c
+    Agrif_tabvars_r => Agrif_Curgrid % tabvars_r
+    Agrif_tabvars_l => Agrif_Curgrid % tabvars_l
+    Agrif_tabvars_i => Agrif_Curgrid % tabvars_i
+!
+#if defined AGRIF_MPI
+    if ( Agrif_Gr % communicator /= -1 ) then
+        call Agrif_MPI_switch_comm( Agrif_Gr % communicator )
+    endif
+#endif
+!
+    call Agrif_Get_numberofcells(Agrif_Gr)
+    call Agrif_InitWorkSpace()
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Instance
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_initialisations
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_initialisations ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+!
+    integer                         :: i
+    type(Agrif_Variable),   pointer :: var => NULL()
+    type(Agrif_Variable_c), pointer :: var_c => NULL()
+    type(Agrif_Variable_r), pointer :: var_r => NULL()
+    type(Agrif_Variable_l), pointer :: var_l => NULL()
+    type(Agrif_Variable_i), pointer :: var_i => NULL()
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Gr % tabvars(i)
+        var % nbdim = 0
+!
+        if (allocated(var%array1)) then
+            var % nbdim = 1
+            var % lb(1:1) = lbound(var%array1)
+            var % ub(1:1) = ubound(var%array1)
+        endif
+        if (allocated(var%array2)) then
+            var % nbdim = 2
+            var % lb(1:2) = lbound(var%array2)
+            var % ub(1:2) = ubound(var%array2)
+        endif
+        if (allocated(var%array3)) then
+            var % nbdim = 3
+            var % lb(1:3) = lbound(var%array3)
+            var % ub(1:3) = ubound(var%array3)
+        endif
+        if (allocated(var%array4)) then
+            var % nbdim = 4
+            var % lb(1:4) = lbound(var%array4)
+            var % ub(1:4) = ubound(var%array4)
+        endif
+        if (allocated(var%array5)) then
+            var % nbdim = 5
+            var % lb(1:5) = lbound(var%array5)
+            var % ub(1:5) = ubound(var%array5)
+        endif
+        if (allocated(var%array6)) then
+            var % nbdim = 6
+            var % lb(1:6) = lbound(var%array6)
+            var % ub(1:6) = ubound(var%array6)
+        endif
+!
+        if (allocated(var%darray1)) var % nbdim = 1
+        if (allocated(var%darray2)) var % nbdim = 2
+        if (allocated(var%darray3)) var % nbdim = 3
+        if (allocated(var%darray4)) var % nbdim = 4
+        if (allocated(var%darray5)) var % nbdim = 5
+        if (allocated(var%darray6)) var % nbdim = 6
+!
+        if (allocated(var%sarray1)) var % nbdim = 1
+        if (allocated(var%sarray2)) var % nbdim = 2
+        if (allocated(var%sarray3)) var % nbdim = 3
+        if (allocated(var%sarray4)) var % nbdim = 4
+        if (allocated(var%sarray5)) var % nbdim = 5
+        if (allocated(var%sarray6)) var % nbdim = 6
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(1)
+!
+        var_c => Agrif_Gr % tabvars_c(i)
+        var_c % nbdim = 0
+!
+        if (allocated(var_c%carray1)) var_c % nbdim = 1
+        if (allocated(var_c%carray2)) var_c % nbdim = 2
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(2)
+!
+        var_r => Agrif_Gr % tabvars_r(i)
+        var_r % nbdim = 0
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(3)
+!
+        var_l => Agrif_Gr % tabvars_l(i)
+        var_l % nbdim = 0
+!
+        if (allocated(var_l%larray1)) var_l % nbdim = 1
+        if (allocated(var_l%larray2)) var_l % nbdim = 2
+        if (allocated(var_l%larray3)) var_l % nbdim = 3
+        if (allocated(var_l%larray4)) var_l % nbdim = 4
+        if (allocated(var_l%larray5)) var_l % nbdim = 5
+        if (allocated(var_l%larray6)) var_l % nbdim = 6
+!
+    enddo
+
+    do i = 1,Agrif_NbVariables(4)
+!
+        var_i => Agrif_Gr % tabvars_i(i)
+        var_i % nbdim = 0
+!
+        if (allocated(var_i%iarray1)) var_i % nbdim = 1
+        if (allocated(var_i%iarray2)) var_i % nbdim = 2
+        if (allocated(var_i%iarray3)) var_i % nbdim = 3
+        if (allocated(var_i%iarray4)) var_i % nbdim = 4
+        if (allocated(var_i%iarray5)) var_i % nbdim = 5
+        if (allocated(var_i%iarray6)) var_i % nbdim = 6
+!
+    enddo
+
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_initialisations
+!===================================================================================================
+!
+end module Agrif_Init
Index: vendors/AGRIF/AGRIF_FILES/modinitvars.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modinitvars.F90	(revision 9621)
@@ -0,0 +1,86 @@
+!
+! $Id$
+!
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Init_Vars
+!>
+!> Initialization of the variables of the current grid.
+!
+module Agrif_Init_Vars
+!
+    use Agrif_Types
+    use Agrif_Grids
+    use Agrif_Link
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Create_Var
+!
+!> Allocation of the list of grid variables for grid Agrif_Gr.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Create_Var ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
+!
+    integer :: nb
+!
+    if (Agrif_NbVariables(0) > 0) allocate(Agrif_Gr % tabvars  (Agrif_NbVariables(0)))
+    if (Agrif_NbVariables(1) > 0) allocate(Agrif_Gr % tabvars_c(Agrif_NbVariables(1)))
+    if (Agrif_NbVariables(2) > 0) allocate(Agrif_Gr % tabvars_r(Agrif_NbVariables(2)))
+    if (Agrif_NbVariables(3) > 0) allocate(Agrif_Gr % tabvars_l(Agrif_NbVariables(3)))
+    if (Agrif_NbVariables(4) > 0) allocate(Agrif_Gr % tabvars_i(Agrif_NbVariables(4)))
+!
+    if ( Agrif_Gr % fixedrank /= 0 ) then
+        do nb = 1, Agrif_NbVariables(0)
+            Agrif_Gr % tabvars(nb) % parent_var => Agrif_Gr % parent % tabvars(nb)
+            Agrif_Gr % tabvars(nb) % nbdim      =  Agrif_Mygrid % tabvars(nb) % nbdim
+            Agrif_Gr % tabvars(nb) % root_var   => Agrif_Mygrid % tabvars(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(1)
+            Agrif_Gr % tabvars_c(nb) % parent_var => Agrif_Gr % parent % tabvars_c(nb)
+            Agrif_Gr % tabvars_c(nb) % nbdim      =  Agrif_Mygrid % tabvars_c(nb) % nbdim
+            Agrif_Gr % tabvars_c(nb) % root_var   => Agrif_Mygrid % tabvars_c(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(2)
+            Agrif_Gr % tabvars_r(nb) % parent_var => Agrif_Gr % parent % tabvars_r(nb)
+            Agrif_Gr % tabvars_r(nb) % nbdim      =  Agrif_Mygrid % tabvars_r(nb) % nbdim
+            Agrif_Gr % tabvars_r(nb) % root_var   => Agrif_Mygrid % tabvars_r(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(3)
+            Agrif_Gr % tabvars_l(nb) % parent_var => Agrif_Gr % parent % tabvars_l(nb)
+            Agrif_Gr % tabvars_l(nb) % nbdim      =  Agrif_Mygrid % tabvars_l(nb) % nbdim
+            Agrif_Gr % tabvars_l(nb) % root_var   => Agrif_Mygrid % tabvars_l(nb)
+        enddo
+        do nb = 1, Agrif_NbVariables(4)
+            Agrif_Gr % tabvars_i(nb) % parent_var => Agrif_Gr % parent % tabvars_i(nb)
+            Agrif_Gr % tabvars_i(nb) % nbdim      =  Agrif_Mygrid % tabvars_i(nb) % nbdim
+            Agrif_Gr % tabvars_i(nb) % root_var   => Agrif_Mygrid % tabvars_i(nb)
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Create_Var
+!===================================================================================================
+!
+end module Agrif_Init_Vars
Index: vendors/AGRIF/AGRIF_FILES/modinterp.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modinterp.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modinterp.F90	(revision 9621)
@@ -0,0 +1,1526 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module to initialize a fine grid from its parent grid, by using a space interpolation
+!
+module Agrif_Interpolation
+!
+    use Agrif_InterpBasic
+    use Agrif_Arrays
+    use Agrif_Mask
+    use Agrif_CurgridFunctions
+#if defined AGRIF_MPI
+    use Agrif_Mpp
+#endif
+!
+    implicit none
+!
+    logical, private:: precomputedone(7) = .FALSE.
+!
+    private :: Agrif_Parentbounds
+    private :: Agrif_Interp_1D_recursive, Agrif_Interp_2D_recursive, Agrif_Interp_3D_recursive
+    private :: Agrif_Interp_4D_recursive, Agrif_Interp_5D_recursive, Agrif_Interp_6D_recursive
+    private :: Agrif_InterpBase
+    private :: Agrif_Find_list_interp, Agrif_AddTo_list_interp
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_InterpVariable
+!
+!> Sets some arguments of subroutine Agrif_InterpnD, n being the dimension of the grid variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpVariable ( parent, child, torestore, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer       :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer       :: child        !< Variable on the child grid
+    logical,              intent(in)    :: torestore    !< .false. indicates that the results of the
+                                                        !! interpolation are applied on the whole current grid
+    procedure()                         :: procname     !< Data recovery procedure
+!---------------------------------------------------------------------------------------------------
+    logical               :: memberin
+    integer               :: nbdim        ! Number of dimensions of the current grid
+    integer, dimension(6) :: type_interp  ! Type of interpolation (linear,spline,...)
+    integer, dimension(6) :: nb_child
+    integer, dimension(6) :: lb_child
+    integer, dimension(6) :: ub_child
+    integer, dimension(6) :: lb_parent
+    real   , dimension(6) :: s_child,   s_parent
+    real   , dimension(6) :: ds_child, ds_parent
+    integer, dimension(child % root_var % nbdim,2,2) :: childarray
+!
+    nbdim       = child % root_var % nbdim
+    type_interp = child % root_var % type_interp
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.true.)
+!
+!   Call to a procedure of interpolation against the number of dimensions of the grid variable
+!
+    call Agrif_InterpnD(type_interp, parent, child, &
+                        lb_child, ub_child,         &
+                        lb_child, lb_parent,        &
+                        s_child,   s_parent,        &
+                        ds_child, ds_parent,        &
+                        child, torestore, nbdim,    &
+                        childarray, memberin,       &
+                        .false., procname, 0, 0)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpnD
+!
+!> Interpolates a nD grid variable from its parent grid, by using a space interpolation
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpnD ( type_interp, parent, child, pttab, petab, pttab_Child, pttab_Parent, &
+                            s_Child, s_Parent, ds_Child, ds_Parent, restore, torestore,          &
+                            nbdim, childarray, memberin, in_bc, procname, nb, ndir )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    INTEGER, DIMENSION(6),     INTENT(in)   :: type_interp  !< Type of interpolation !    (linear,...)
+    TYPE(Agrif_Variable),      pointer      :: parent       !< Variable of the parent grid
+    TYPE(Agrif_Variable),      pointer      :: child        !< Variable of the child grid
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab        !< Index of the first point inside the domain
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: petab        !< Index of the first point inside the domain
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Child  !< Index of the first point inside the domain
+                                                            !<    for the child grid variable
+    INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Parent !< Index of the first point inside the domain
+                                                            !<    for the parent grid variable
+    REAL,    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids
+    REAL,    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids
+    TYPE(Agrif_Variable),      pointer      :: restore            !< Indicates points where interpolation
+    LOGICAL,                   INTENT(in)   :: torestore          !< Indicates if the array restore is used
+    INTEGER,                   INTENT(in)   :: nbdim
+    LOGICAL,                   INTENT(out)  :: memberin
+    LOGICAL,                   INTENT(in)   :: in_bc              !< .true. if called from Agrif_CorrectVariable \n
+                                                                  !! .false. if called from Agrif_InterpVariable
+    procedure()                             :: procname           !< Data recovery procedure
+    INTEGER,                   INTENT(in)   :: nb, ndir
+!
+    INTEGER                       :: i,j,k,l,m,n
+    INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab
+    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax
+    INTEGER, DIMENSION(nbdim)     :: indminglob, indmaxglob
+#if defined AGRIF_MPI
+    INTEGER, DIMENSION(nbdim)     :: indminglob2,indmaxglob2
+#endif
+    LOGICAL, DIMENSION(nbdim)     :: noraftab
+    REAL   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp
+    INTEGER, DIMENSION(nbdim)     :: lowerbound, upperbound, coords
+    INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray
+    INTEGER, DIMENSION(nbdim,2,2)              :: parentarray
+    LOGICAL :: member
+    LOGICAL :: find_list_interp
+!
+#if defined AGRIF_MPI
+!
+    INTEGER, PARAMETER          :: etiquette = 100
+    INTEGER                     :: code, local_proc
+    INTEGER, DIMENSION(nbdim,4)                     :: tab3
+    INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1)   :: tab4
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: memberinall
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: sendtoproc1, recvfromproc1
+    LOGICAL, DIMENSION(1)                           :: memberin1
+    LOGICAL                                         :: memberout
+!
+#endif
+!
+    type(Agrif_Variable), pointer, save :: tempC => NULL()        ! Temporary child grid variable
+    type(Agrif_Variable), pointer, save :: tempP => NULL()        ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: tempPextend => NULL()  ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: parentvalues => NULL()
+!
+    coords = child % root_var % coords
+!
+!   Boundaries of the current grid where interpolation is done
+    find_list_interp =                                              &
+        Agrif_Find_list_interp(                                     &
+            child % list_interp,                                    &
+            pttab, petab, pttab_Child, pttab_Parent, nbdim,         &
+            indmin, indmax, indminglob, indmaxglob,                 &
+            pttruetab, cetruetab, memberin                          &
+#if defined AGRIF_MPI
+           ,indminglob2, indmaxglob2, parentarray,                  &
+            member, tab4t,memberinall,  sendtoproc1, recvfromproc1  &
+#endif
+        )
+!
+    if (.not.find_list_interp) then
+!
+        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+        call Agrif_Childbounds(nbdim, lowerbound, upperbound,               &
+                               pttab, petab, Agrif_Procrank, coords,        &
+                               pttruetab, cetruetab, memberin)
+        call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    &
+                                s_Parent_temp,s_Child_temp,                 &
+                                s_Child,ds_Child,                           &
+                                s_Parent,ds_Parent,                         &
+                                pttab,petab,                                &
+                                pttab_Child,pttab_Parent,                   &
+                                child%root_var % posvar, coords)
+#if defined AGRIF_MPI
+        if (memberin) then
+            call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax,        &
+                                    s_Parent_temp,s_Child_temp,             &
+                                    s_Child,ds_Child,                       &
+                                    s_Parent,ds_Parent,                     &
+                                    pttruetab,cetruetab,                    &
+                                    pttab_Child,pttab_Parent,               &
+                                    child%root_var % posvar, coords)
+        endif
+
+        local_proc = Agrif_Procrank
+        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
+                               indminglob,indmaxglob, local_proc, coords,   &
+                               indminglob2,indmaxglob2,member)
+!
+        if (member) then
+            call Agrif_GlobalToLocalBounds(parentarray,                     &
+                                           lowerbound,  upperbound,         &
+                                           indminglob2, indmaxglob2, coords,&
+                                           nbdim, local_proc, member)
+        endif
+
+        call Agrif_ParentGrid_to_ChildGrid()
+#else
+        parentarray(:,1,1) = indminglob
+        parentarray(:,2,1) = indmaxglob
+        parentarray(:,1,2) = indminglob
+        parentarray(:,2,2) = indmaxglob
+        indmin = indminglob
+        indmax = indmaxglob
+        member = .TRUE.
+#endif
+
+    else
+
+#if defined AGRIF_MPI
+        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+        s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
+#else
+        parentarray(:,1,1) = indminglob
+        parentarray(:,2,1) = indmaxglob
+        parentarray(:,1,2) = indminglob
+        parentarray(:,2,2) = indmaxglob
+        indmin = indminglob
+        indmax = indmaxglob
+        member = .TRUE.
+        s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent
+        s_Child_temp  = s_Child + (pttab - pttab_Child) * ds_Child
+#endif
+    endif
+!
+    if (member) then
+        if (.not.associated(tempP)) allocate(tempP)
+!
+        call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim)
+        call Agrif_var_set_array_tozero(tempP,nbdim)
+
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        select case (nbdim)
+        case(1)
+            call procname(tempP%array1,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir)
+        case(2)
+            call procname(tempP%array2,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir)
+        case(3)
+            call procname(tempP%array3,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir)
+        case(4)
+            call procname(tempP%array4,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir)
+        case(5)
+            call procname(tempP%array5,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),    &
+                      parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir)
+        case(6)
+            call procname(tempP%array6,                         &
+                      parentarray(1,1,2),parentarray(1,2,2),    &
+                      parentarray(2,1,2),parentarray(2,2,2),    &
+                      parentarray(3,1,2),parentarray(3,2,2),    &
+                      parentarray(4,1,2),parentarray(4,2,2),    &
+                      parentarray(5,1,2),parentarray(5,2,2),    &
+                      parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
+        end select
+!
+        call Agrif_ParentGrid_to_ChildGrid()
+!
+    endif
+
+#if defined AGRIF_MPI
+    if (.not.find_list_interp) then
+!
+        tab3(:,1) = indminglob2(:)
+        tab3(:,2) = indmaxglob2(:)
+        tab3(:,3) = indmin(:)
+        tab3(:,4) = indmax(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        if (.not.associated(tempPextend))   allocate(tempPextend)
+
+        do k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = memberin
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+
+        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),         &
+                                     tab4t(:,:,3),tab4t(:,:,4),         &
+                                     nbdim,memberinall, coords,         &
+                                     sendtoproc1,recvfromproc1,         &
+                                     tab4t(:,:,5),tab4t(:,:,6),         &
+                                     tab4t(:,:,7),tab4t(:,:,8) )
+    endif
+
+    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
+            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
+            tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,tempPextend)
+#else
+    tempPextend => tempP
+#endif
+
+    if (.not.find_list_interp) then
+        call Agrif_Addto_list_interp(                           &
+                child%list_interp,pttab,petab,                  &
+                pttab_Child,pttab_Parent,indmin,indmax,         &
+                indminglob,indmaxglob,                          &
+                pttruetab,cetruetab,                            &
+                memberin,nbdim                                  &
+#if defined AGRIF_MPI
+               ,indminglob2,indmaxglob2,                        &
+                parentarray,                                    &
+                member,                                         &
+                tab4t,memberinall,sendtoproc1,recvfromproc1     &
+#endif
+        )
+    endif
+!
+    if (memberin) then
+!
+        if (.not.associated(tempC)) allocate(tempC)
+!
+        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+!
+!       Special values on the parent grid
+        if (Agrif_UseSpecialValue) then
+!
+            noraftab(1:nbdim) = child % root_var % interptab(1:nbdim) == 'N'
+!
+            if (.not.associated(parentvalues))  allocate(parentvalues)
+!
+            call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim)
+            call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim)
+!
+            call Agrif_CheckMasknD(tempPextend,parentvalues,    &
+                    indmin(1:nbdim),indmax(1:nbdim),            &
+                    indmin(1:nbdim),indmax(1:nbdim),            &
+                    noraftab(1:nbdim),nbdim)
+!
+            call Agrif_array_deallocate(parentvalues,nbdim)
+!
+        endif
+!
+!       Interpolation of the current grid
+!
+        if ( memberin ) then
+            select case(nbdim)
+            case(1)
+                call Agrif_Interp_1D_recursive( type_interp(1),                         &
+                                                tempPextend%array1,                     &
+                                                tempC%array1,                           &
+                                                indmin(1), indmax(1),                   &
+                                                pttruetab(1),    cetruetab(1),          &
+                                                s_Child_temp(1), s_Parent_temp(1),      &
+                                                ds_Child(1),     ds_Parent(1) )
+            case(2)
+                call Agrif_Interp_2D_recursive( type_interp(1:2),                       &
+                                                tempPextend % array2,                   &
+                                                tempC       % array2,                   &
+                                                indmin(1:2), indmax(1:2),               &
+                                                pttruetab(1:2),    cetruetab(1:2),      &
+                                                s_Child_temp(1:2), s_Parent_temp(1:2),  &
+                                                ds_Child(1:2),    ds_Parent(1:2) )
+            case(3)
+                call Agrif_Interp_3D_recursive( type_interp(1:3),                       &
+                                                tempPextend % array3,                   &
+                                                tempC       % array3,                   &
+                                                indmin(1:3), indmax(1:3),               &
+                                                pttruetab(1:3),    cetruetab(1:3),      &
+                                                s_Child_temp(1:3), s_Parent_temp(1:3),  &
+                                                ds_Child(1:3),    ds_Parent(1:3) )
+            case(4)
+                call Agrif_Interp_4D_recursive( type_interp(1:4),                       &
+                                                tempPextend % array4,                   &
+                                                tempC       % array4,                   &
+                                                indmin(1:4), indmax(1:4),               &
+                                                pttruetab(1:4),    cetruetab(1:4),      &
+                                                s_Child_temp(1:4), s_Parent_temp(1:4),  &
+                                                ds_Child(1:4),    ds_Parent(1:4) )
+            case(5)
+                call Agrif_Interp_5D_recursive( type_interp(1:5),                       &
+                                                tempPextend % array5,                   &
+                                                tempC       % array5,                   &
+                                                indmin(1:5), indmax(1:5),               &
+                                                pttruetab(1:5),    cetruetab(1:5),      &
+                                                s_Child_temp(1:5), s_Parent_temp(1:5),  &
+                                                ds_Child(1:5),    ds_Parent(1:5) )
+            case(6)
+                call Agrif_Interp_6D_recursive( type_interp(1:6),                       &
+                                                tempPextend % array6,                   &
+                                                tempC       % array6,                   &
+                                                indmin(1:6), indmax(1:6),               &
+                                                pttruetab(1:6),    cetruetab(1:6),      &
+                                                s_Child_temp(1:6), s_Parent_temp(1:6),  &
+                                                ds_Child(1:6),    ds_Parent(1:6) )
+            end select
+!
+            call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim)
+
+#if defined AGRIF_MPI
+            call Agrif_GlobalToLocalBounds(childarray, lowerbound, upperbound,  &
+                                            pttruetab, cetruetab, coords,       &
+                                            nbdim, Agrif_Procrank, memberout)
+#else
+            childarray(:,1,1) = pttruetab
+            childarray(:,2,1) = cetruetab
+            childarray(:,1,2) = pttruetab
+            childarray(:,2,2) = cetruetab
+!cccccccccccccc       memberout = .TRUE.
+#endif
+!
+!           Special values on the child grid
+            if (Agrif_UseSpecialValueFineGrid) then
+                call GiveAgrif_SpecialValueToTab_mpi( child, tempC, childarray, Agrif_SpecialValueFineGrid,nbdim )
+            endif
+!
+        endif   ! ( memberin )
+!
+        if (torestore) then
+!
+#if defined AGRIF_MPI
+!
+            SELECT CASE (nbdim)
+            CASE (1)
+                do i = pttruetab(1),cetruetab(1)
+!hildarrayAModifier     if (restore%restore1D(i) == 0)      &
+!hildarrayAModifier         child%array1(childarray(i,1,2)) = tempC%array1(i)
+                enddo
+            CASE (2)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+!hildarrayAModifier     if (restore%restore2D(i,j) == 0)    &
+!hildarrayAModifier         child%array2(childarray(i,1,2), &
+!hildarrayAModifier                          childarray(j,2,2)) = tempC%array2(i,j)
+                enddo
+                enddo
+            CASE (3)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+!hildarrayAModifier     if (restore%restore3D(i,j,k) == 0)  &
+!hildarrayAModifier         child%array3(childarray(i,1,2), &
+!hildarrayAModifier                          childarray(j,2,2), &
+!hildarrayAModifier                          childarray(k,3,2)) = tempC%array3(i,j,k)
+                enddo
+                enddo
+                enddo
+            CASE (4)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+!hildarrayAModifier     if (restore%restore4D(i,j,k,l) == 0)    &
+!hildarrayAModifier         child%array4(childarray(i,1,2),     &
+!hildarrayAModifier                          childarray(j,2,2),     &
+!hildarrayAModifier                          childarray(k,3,2),     &
+!hildarrayAModifier                          childarray(l,4,2)) = tempC%array4(i,j,k,l)
+                enddo
+                enddo
+                enddo
+                enddo
+            CASE (5)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+                do m = pttruetab(5),cetruetab(5)
+!hildarrayAModifier     if (restore%restore5D(i,j,k,l,m) == 0)  &
+!hildarrayAModifier         child%array5(childarray(i,1,2),     &
+!hildarrayAModifier                          childarray(j,2,2),     &
+!hildarrayAModifier                          childarray(k,3,2),     &
+!hildarrayAModifier                          childarray(l,4,2),     &
+!hildarrayAModifier                          childarray(m,5,2)) = tempC%array5(i,j,k,l,m)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            CASE (6)
+                do i = pttruetab(1),cetruetab(1)
+                do j = pttruetab(2),cetruetab(2)
+                do k = pttruetab(3),cetruetab(3)
+                do l = pttruetab(4),cetruetab(4)
+                do m = pttruetab(5),cetruetab(5)
+                do n = pttruetab(6),cetruetab(6)
+!hildarrayAModifier     if (restore%restore6D(i,j,k,l,m,n) == 0)    &
+!hildarrayAModifier         child%array6(childarray(i,1,2),         &
+!hildarrayAModifier                          childarray(j,2,2),         &
+!hildarrayAModifier                          childarray(k,3,2),         &
+!hildarrayAModifier                          childarray(l,4,2),         &
+!hildarrayAModifier                          childarray(m,5,2),         &
+!hildarrayAModifier                          childarray(n,6,2)) = tempC%array6(i,j,k,l,m,n)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            END SELECT
+!
+#else
+            select case (nbdim)
+            case (1)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore1D(i) == 0)          &
+                        parray1(i) = tempC % array1(i)
+                enddo
+            case (2)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore2D(i,j) == 0)        &
+                        parray2(i,j) = tempC % array2(i,j)
+                enddo
+                enddo
+            case (3)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore3D(i,j,k) == 0)      &
+                        parray3(i,j,k) = tempC % array3(i,j,k)
+                enddo
+                enddo
+                enddo
+            case (4)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore4D(i,j,k,l) == 0)    &
+                        parray4(i,j,k,l) = tempC % array4(i,j,k,l)
+                enddo
+                enddo
+                enddo
+                enddo
+            case (5)
+                do m = pttruetab(5),cetruetab(5)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore5D(i,j,k,l,m) == 0)  &
+                        parray5(i,j,k,l,m) = tempC % array5(i,j,k,l,m)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            case (6)
+                do n = pttruetab(6),cetruetab(6)
+                do m = pttruetab(5),cetruetab(5)
+                do l = pttruetab(4),cetruetab(4)
+                do k = pttruetab(3),cetruetab(3)
+                do j = pttruetab(2),cetruetab(2)
+                do i = pttruetab(1),cetruetab(1)
+                    if (restore%restore6D(i,j,k,l,m,n) == 0)    &
+                        parray6(i,j,k,l,m,n) = tempC % array6(i,j,k,l,m,n)
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+                enddo
+            end select
+!
+#endif
+!
+        else    ! .not.to_restore
+!
+            if (memberin) then
+    !
+                if ( .not.in_bc ) then
+                    select case(nbdim)
+                    case(1)
+                        call procname(tempC % array1(            &
+                                childarray(1,1,1):childarray(1,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),.FALSE.,nb,ndir)
+                    case(2)
+                        call procname(                                &
+                                tempC % array2(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),.FALSE.,nb,ndir)
+                    case(3)
+                        call procname(                                &
+                                tempC % array3(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),.FALSE.,nb,ndir)
+                    case(4)
+                        call procname(                                &
+                                tempC % array4(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),.FALSE.,nb,ndir)
+                    case(5)
+                        call procname(                                &
+                                tempC % array5(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1),  &
+                                childarray(5,1,1):childarray(5,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),  &
+                                childarray(5,1,2),childarray(5,2,2),.FALSE.,nb,ndir)
+                    case(6)
+                        call procname(                                &
+                                tempC % array6(            &
+                                childarray(1,1,1):childarray(1,2,1),  &
+                                childarray(2,1,1):childarray(2,2,1),  &
+                                childarray(3,1,1):childarray(3,2,1),  &
+                                childarray(4,1,1):childarray(4,2,1),  &
+                                childarray(5,1,1):childarray(5,2,1),  &
+                                childarray(6,1,1):childarray(6,2,1)), &
+                                childarray(1,1,2),childarray(1,2,2),  &
+                                childarray(2,1,2),childarray(2,2,2),  &
+                                childarray(3,1,2),childarray(3,2,2),  &
+                                childarray(4,1,2),childarray(4,2,2),  &
+                                childarray(5,1,2),childarray(5,2,2),  &
+                                childarray(6,1,2),childarray(6,2,2),.FALSE.,nb,ndir)
+                    end select
+                else    ! we are in_bc
+                    select case (nbdim)
+                    case (1)
+                        parray1(childarray(1,1,2):childarray(1,2,2)) =    &
+                         tempC%array1(childarray(1,1,1):childarray(1,2,1))
+                    case (2)
+                        parray2(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2)) =    &
+                         tempC%array2(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1))
+                    case (3)
+                        parray3(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2)) =    &
+                         tempC%array3(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1))
+                    case (4)
+                        parray4(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2)) =    &
+                         tempC%array4(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1))
+                    case (5)
+                        parray5(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2),      &
+                                      childarray(5,1,2):childarray(5,2,2)) =    &
+                         tempC%array5(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1),      &
+                                      childarray(5,1,1):childarray(5,2,1))
+                    case (6)
+                        parray6(childarray(1,1,2):childarray(1,2,2),      &
+                                      childarray(2,1,2):childarray(2,2,2),      &
+                                      childarray(3,1,2):childarray(3,2,2),      &
+                                      childarray(4,1,2):childarray(4,2,2),      &
+                                      childarray(5,1,2):childarray(5,2,2),      &
+                                      childarray(6,1,2):childarray(6,2,2)) =    &
+                         tempC%array6(childarray(1,1,1):childarray(1,2,1),      &
+                                      childarray(2,1,1):childarray(2,2,1),      &
+                                      childarray(3,1,1):childarray(3,2,1),      &
+                                      childarray(4,1,1):childarray(4,2,1),      &
+                                      childarray(5,1,1):childarray(5,2,1),      &
+                                      childarray(6,1,1):childarray(6,2,1))
+                    end select
+                endif  ! < (.not.in_bc)
+            endif  ! < memberin
+!
+        endif
+
+        call Agrif_array_deallocate(tempPextend,nbdim)
+        call Agrif_array_deallocate(tempC,nbdim)
+
+    endif
+!
+!   Deallocations
+#if defined AGRIF_MPI
+    if (member) then
+        call Agrif_array_deallocate(tempP,nbdim)
+    endif
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpnD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Parentbounds
+!
+!> Calculates the bounds of the parent grid for the interpolation of the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, &
+                                s_Parent_temp, s_Child_temp,        &
+                                s_Child, ds_Child,                  &
+                                s_Parent,ds_Parent,                 &
+                                pttruetab, cetruetab,               &
+                                pttab_Child, pttab_Parent, posvar, coords )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, DIMENSION(6),     intent(in)  :: type_interp
+    INTEGER,                   intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax
+    REAL,    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp
+    REAL,    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child
+    REAL,    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent
+    INTEGER, DIMENSION(nbdim), intent(in)  :: pttruetab, cetruetab
+    INTEGER, DIMENSION(nbdim), intent(in)  :: pttab_Child, pttab_Parent
+    INTEGER, DIMENSION(nbdim), intent(in)  :: posvar
+    INTEGER, DIMENSION(nbdim), intent(in)  :: coords
+!
+    INTEGER :: i
+    REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax
+!
+    dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
+    dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
+!
+    do i = 1,nbdim
+!
+        indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
+        indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+!
+!       Necessary for the Quadratic interpolation
+!
+        if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then
+        elseif ( coords(i) == 0 ) then  ! (interptab == 'N')
+        elseif ( (type_interp(i) == Agrif_ppm)     .or.     &
+                 (type_interp(i) == Agrif_eno)     .or.     &
+                 (type_interp(i) == Agrif_ppm_lim) .or.     &
+                 (type_interp(i) == Agrif_weno) ) then
+            indmin(i) = indmin(i) - 2
+            indmax(i) = indmax(i) + 2
+
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+
+        elseif ( (type_interp(i) /= Agrif_constant) .and.   &
+                 (type_interp(i) /= Agrif_linear) ) then
+            indmin(i) = indmin(i) - 1
+            indmax(i) = indmax(i) + 1
+
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+
+        elseif ( (type_interp(i) == Agrif_constant) .or.   &
+                 (type_interp(i) == Agrif_linear) ) then
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+
+        endif
+!
+    enddo
+!
+    s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
+    s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Parentbounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_1D_Recursive
+!
+!> Subroutine for the interpolation of a 1D grid variable.
+!> It calls Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_1D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer,            intent(in)  :: type_interp
+    integer,            intent(in)  :: indmin, indmax
+    integer,            intent(in)  :: pttab_child, petab_child
+    real,               intent(in)  :: s_child, s_parent
+    real,               intent(in)  :: ds_child, ds_parent
+    real, dimension(            &
+        indmin:indmax           &
+    ),                  intent(in)  :: tabin
+    real, dimension(            &
+        pttab_child:petab_child &
+    ),                  intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    call Agrif_InterpBase(type_interp,                      &
+                          tabin(indmin:indmax),             &
+                          tabout(pttab_child:petab_child),  &
+                          indmin, indmax,                   &
+                          pttab_child, petab_child,         &
+                          s_parent,    s_child,             &
+                         ds_parent,   ds_child)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_1D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_2D_Recursive
+!
+!> Subroutine for the interpolation of a 2D grid variable.
+!> It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_2D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(2),              intent(in)  :: type_interp
+    integer, dimension(2),              intent(in)  :: indmin, indmax
+    integer, dimension(2),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(2),              intent(in)  :: s_child, s_parent
+    real,    dimension(2),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        indmin(2):indmax(2))            :: tabtemp
+    real, dimension(                    &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(1):petab_child(1))  :: tabout_trsp
+    real, dimension(                    &
+        indmin(2):indmax(2),            &
+        pttab_child(1):petab_child(1))  :: tabtemp_trsp
+    integer                             :: i, j, coeffraf
+!---------------------------------------------------------------------------------------------------
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    if ((type_interp(1) == Agrif_Linear) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(1))     &
+            call Linear1dPrecompute2d(                  &
+                    indmax(2)-indmin(2)+1,              &
+                    indmax(1)-indmin(1)+1,              &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+        call Linear1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+!
+    elseif ((type_interp(1) == Agrif_PPM) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(1))     &
+            call PPM1dPrecompute2d(                     &
+                    indmax(2)-indmin(2)+1,              &
+                    indmax(1)-indmin(1)+1,              &
+                    petab_child(1)-pttab_child(1)+1,        &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!---CDIR NEXPAND
+        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+    else
+        do j = indmin(2),indmax(2)
+!
+!---CDIR NEXPAND
+            call Agrif_Interp_1D_recursive(type_interp(1),                  &
+                    tabin(indmin(1):indmax(1),j),               &
+                    tabtemp(pttab_child(1):petab_child(1),j),   &
+                    indmin(1),indmax(1),                    &
+                    pttab_child(1),petab_child(1),          &
+                    s_child(1), s_parent(1),                &
+                    ds_child(1),ds_parent(1))
+!
+        enddo
+    endif
+
+    coeffraf = nint(ds_parent(2)/ds_child(2))
+    tabtemp_trsp = TRANSPOSE(tabtemp)
+
+    if ((type_interp(2) == Agrif_Linear) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(2))     &
+            call Linear1dPrecompute2d(                  &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    indmax(2)-indmin(2)+1,              &
+                    petab_child(2)-pttab_child(2)+1,    &
+                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+        call Linear1dAfterCompute(tabtemp_trsp,tabout_trsp, &
+                size(tabtemp_trsp),size(tabout_trsp),2)
+
+    elseif ((type_interp(2) == Agrif_PPM) .and. (coeffraf /= 1)) then
+!---CDIR NEXPAND
+        if(.NOT. precomputedone(2))     &
+            call PPM1dPrecompute2d(                     &
+                    petab_child(1)-pttab_child(1)+1,    &
+                    indmax(2)-indmin(2)+1,              &
+                    petab_child(2)-pttab_child(2)+1,    &
+                    s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!---CDIR NEXPAND
+        call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp,    &
+                               size(tabtemp_trsp), size(tabout_trsp), 2)
+    else
+        do i = pttab_child(1), petab_child(1)
+!
+!---CDIR NEXPAND
+            call Agrif_InterpBase(type_interp(2),                                   &
+                                  tabtemp_trsp(indmin(2):indmax(2), i),             &
+                                  tabout_trsp(pttab_child(2):petab_child(2), i),    &
+                                  indmin(2), indmax(2),                             &
+                                  pttab_child(2), petab_child(2),                   &
+                                  s_parent(2),    s_child(2),                       &
+                                 ds_parent(2),   ds_child(2) )
+        enddo
+    endif
+!
+    tabout = TRANSPOSE(tabout_trsp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_2D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_3D_Recursive
+!
+!> Subroutine for the interpolation of a 3D grid variable.
+!> It calls #Agrif_Interp_2D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_3D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),              intent(in)  :: type_interp
+    integer, dimension(3),              intent(in)  :: indmin, indmax
+    integer, dimension(3),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(3),              intent(in)  :: s_child, s_parent
+    real,    dimension(3),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        indmin(3):indmax(3))            :: tabtemp
+    integer                             :: i, j, k, coeffraf
+    integer                             :: locind_child_left, kdeb
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+    if ( (type_interp(1) == Agrif_Linear) .and. (coeffraf/=1) ) then
+        call Linear1dPrecompute2d(indmax(2)-indmin(2)+1,            &
+                                  indmax(1)-indmin(1)+1,            &
+                                  petab_child(1)-pttab_child(1)+1,  &
+                                  s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    elseif ( (type_interp(1) == Agrif_PPM) .and. (coeffraf/=1) ) then
+        call PPM1dPrecompute2d(indmax(2)-indmin(2)+1,           &
+                               indmax(1)-indmin(1)+1,           &
+                               petab_child(1)-pttab_child(1)+1, &
+                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    endif
+
+    coeffraf = nint ( ds_parent(2) / ds_child(2) )
+    if ( (type_interp(2) == Agrif_Linear) .and. (coeffraf/=1) ) then
+        call Linear1dPrecompute2d(petab_child(1)-pttab_child(1)+1,  &
+                                  indmax(2)-indmin(2)+1,            &
+                                  petab_child(2)-pttab_child(2)+1,  &
+                                  s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    elseif ( (type_interp(2) == Agrif_PPM) .and. (coeffraf/=1) ) then
+        call PPM1dPrecompute2d(petab_child(1)-pttab_child(1)+1, &
+                               indmax(2)-indmin(2)+1,           &
+                               petab_child(2)-pttab_child(2)+1, &
+                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    endif
+!
+    do k = indmin(3), indmax(3)
+        call Agrif_Interp_2D_recursive(type_interp(1:2),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2), k),               &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2), k),   &
+                                       indmin(1:2), indmax(1:2),                    &
+                                       pttab_child(1:2), petab_child(1:2),          &
+                                       s_child(1:2),     s_parent(1:2),             &
+                                       ds_child(1:2),   ds_parent(1:2) )
+    enddo
+!
+    precomputedone(1) = .FALSE.
+    precomputedone(2) = .FALSE.
+    coeffraf = nint(ds_parent(3)/ds_child(3))
+!
+    if ( coeffraf == 1 ) then
+        locind_child_left = 1 + agrif_int((s_child(3)-s_parent(3))/ds_parent(3))
+        kdeb = indmin(3)+locind_child_left-2
+        do k = pttab_child(3),petab_child(3)
+            kdeb = kdeb + 1
+            do j = pttab_child(2), petab_child(2)
+            do i = pttab_child(1), petab_child(1)
+                tabout(i,j,k) = tabtemp(i,j,kdeb)
+            enddo
+            enddo
+        enddo
+    else
+        do j = pttab_child(2), petab_child(2)
+        do i = pttab_child(1), petab_child(1)
+            call Agrif_InterpBase(type_interp(3),                                   &
+                                  tabtemp(i,j,indmin(3):indmax(3)),                 &
+                                  tabout(i,j,pttab_child(3):petab_child(3)),        &
+                                  indmin(3), indmax(3),                             &
+                                  pttab_child(3), petab_child(3),                   &
+                                  s_parent(3),    s_child(3),                       &
+                                 ds_parent(3),   ds_child(3) )
+        enddo
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_3D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_4D_Recursive
+!
+!> Subroutine for the interpolation of a 4D grid variable.
+!> It calls #Agrif_Interp_3D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_4D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(4),              intent(in)  :: type_interp
+    integer, dimension(4),              intent(in)  :: indmin, indmax
+    integer, dimension(4),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(4),              intent(in)  :: s_child, s_parent
+    real,    dimension(4),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        indmin(4):indmax(4))            :: tabtemp
+    integer                             :: i, j, k, l
+!
+    do l = indmin(4), indmax(4)
+        call Agrif_Interp_3D_recursive(type_interp(1:3),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3), l),               &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2),       &
+                                               pttab_child(3):petab_child(3), l),   &
+                                       indmin(1:3), indmax(1:3),                    &
+                                       pttab_child(1:3), petab_child(1:3),          &
+                                       s_child(1:3),    s_parent(1:3),              &
+                                       ds_child(1:3),  ds_parent(1:3) )
+    enddo
+!
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(4),                                       &
+                              tabtemp(i,j,k,indmin(4):indmax(4)),                   &
+                              tabout(i,j,k,pttab_child(4):petab_child(4)),          &
+                              indmin(4), indmax(4),                                 &
+                              pttab_child(4), petab_child(4),                       &
+                              s_parent(4),    s_child(4),                           &
+                             ds_parent(4),   ds_child(4) )
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_4D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_5D_Recursive
+!
+!> Subroutine for the interpolation of a 5D grid variable.
+!> It calls #Agrif_Interp_4D_recursive and #Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_5D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(5),              intent(in)  :: type_interp
+    integer, dimension(5),              intent(in)  :: indmin, indmax
+    integer, dimension(5),              intent(in)  :: pttab_child, petab_child
+    real,    dimension(5),              intent(in)  :: s_child, s_parent
+    real,    dimension(5),              intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4),            &
+        indmin(5):indmax(5)),           intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5)), intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        indmin(5):indmax(5))            :: tabtemp
+    integer                             :: i, j, k, l, m
+!
+    do m = indmin(5), indmax(5)
+        call Agrif_Interp_4D_recursive(type_interp(1:4),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3),                   &
+                                             indmin(4):indmax(4),m),                &
+                                       tabtemp(pttab_child(1):petab_child(1),       &
+                                               pttab_child(2):petab_child(2),       &
+                                               pttab_child(3):petab_child(3),       &
+                                               pttab_child(4):petab_child(4), m),   &
+                                       indmin(1:4),indmax(1:4),                     &
+                                       pttab_child(1:4), petab_child(1:4),          &
+                                       s_child(1:4),     s_parent(1:4),             &
+                                       ds_child(1:4),   ds_parent(1:4) )
+    enddo
+!
+    do l = pttab_child(4), petab_child(4)
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(5),                                       &
+                              tabtemp(i,j,k,l,indmin(5):indmax(5)),                 &
+                              tabout(i,j,k,l,pttab_child(5):petab_child(5)),        &
+                              indmin(5), indmax(5),                                 &
+                              pttab_child(5), petab_child(5),                       &
+                              s_parent(5),   s_child(5),                            &
+                              ds_parent(5), ds_child(5) )
+    enddo
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_5D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Interp_6D_Recursive
+!
+!> Subroutine for the interpolation of a 6D grid variable.
+!> It calls #Agrif_Interp_5D_recursive and Agrif_InterpBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Interp_6D_recursive ( type_interp, tabin, tabout,  &
+                                       indmin, indmax,              &
+                                       pttab_child, petab_child,    &
+                                       s_child,  s_parent,          &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6),                  intent(in)  :: type_interp
+    integer, dimension(6),                  intent(in)  :: indmin, indmax
+    integer, dimension(6),                  intent(in)  :: pttab_child, petab_child
+    real,    dimension(6),                  intent(in)  :: s_child, s_parent
+    real,    dimension(6),                  intent(in)  :: ds_child, ds_parent
+    real,    dimension(                 &
+        indmin(1):indmax(1),            &
+        indmin(2):indmax(2),            &
+        indmin(3):indmax(3),            &
+        indmin(4):indmax(4),            &
+        indmin(5):indmax(5),            &
+        indmin(6):indmax(6)),               intent(in)  :: tabin
+    real,    dimension(                 &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5),  &
+        pttab_child(6):petab_child(6)),     intent(out) :: tabout
+!---------------------------------------------------------------------------------------------------
+    real, dimension(                    &
+        pttab_child(1):petab_child(1),  &
+        pttab_child(2):petab_child(2),  &
+        pttab_child(3):petab_child(3),  &
+        pttab_child(4):petab_child(4),  &
+        pttab_child(5):petab_child(5),  &
+        indmin(6):indmax(6))            :: tabtemp
+    integer                             :: i, j, k, l, m, n
+!
+    do n = indmin(6), indmax(6)
+        call Agrif_Interp_5D_recursive(type_interp(1:5),                            &
+                                       tabin(indmin(1):indmax(1),                   &
+                                             indmin(2):indmax(2),                   &
+                                             indmin(3):indmax(3),                   &
+                                             indmin(4):indmax(4),                   &
+                                             indmin(5):indmax(5), n),               &
+                                        tabtemp(pttab_child(1):petab_child(1),      &
+                                                pttab_child(2):petab_child(2),      &
+                                                pttab_child(3):petab_child(3),      &
+                                                pttab_child(4):petab_child(4),      &
+                                                pttab_child(5):petab_child(5), n),  &
+                                        indmin(1:5),indmax(1:5),                    &
+                                        pttab_child(1:5), petab_child(1:5),         &
+                                        s_child(1:5), s_parent(1:5),                &
+                                        ds_child(1:5),ds_parent(1:5) )
+    enddo
+!
+    do m = pttab_child(5), petab_child(5)
+    do l = pttab_child(4), petab_child(4)
+    do k = pttab_child(3), petab_child(3)
+    do j = pttab_child(2), petab_child(2)
+    do i = pttab_child(1), petab_child(1)
+        call Agrif_InterpBase(type_interp(6),                                       &
+                              tabtemp(i,j,k,l,m,indmin(6):indmax(6)),               &
+                              tabout(i,j,k,l,m,pttab_child(6):petab_child(6)),      &
+                              indmin(6), indmax(6),                                 &
+                              pttab_child(6), petab_child(6),                       &
+                              s_parent(6),   s_child(6),                            &
+                              ds_parent(6), ds_child(6) )
+    enddo
+    enddo
+    enddo
+    enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Interp_6D_recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_InterpBase
+!
+!> Calls the interpolation method chosen by the user (linear, lagrange, spline, etc.).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_InterpBase ( type_interp, parenttab, childtab, indmin, indmax, &
+                              pttab_child, petab_child,                         &
+                              s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    INTEGER                                                 :: type_interp
+    INTEGER                                                 :: indmin, indmax
+    INTEGER                                                 :: pttab_child, petab_child
+    REAL, DIMENSION(indmin:indmax),           INTENT(IN)    :: parenttab
+    REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT)   :: childtab
+    REAL                                                    :: s_parent, s_child
+    REAL                                                    :: ds_parent,ds_child
+!
+    if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then
+!
+        childtab(pttab_child) = parenttab(indmin)
+!
+    elseif (type_interp == Agrif_LINEAR) then    !       Linear interpolation
+!
+        call Agrif_basicinterp_linear1D(parenttab,childtab,                   &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif ( type_interp == Agrif_PPM ) then     !       PPM interpolation
+
+        call PPM1d(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif ( type_interp == Agrif_PPM_LIM ) then     !       PPM interpolation
+
+        call PPM1d_lim(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LAGRANGE) then  !       Lagrange interpolation
+!
+        call lagrange1D(parenttab,childtab,                 &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_ENO) then       !       Eno interpolation
+!
+        call ENO1d(parenttab,childtab,                      &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_WENO) then      !       Weno interpolation
+!
+        call WENO1d(parenttab,childtab,                     &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LINEARCONSERV) then !   Linear conservative interpolation
+!
+        call Linear1dConserv(parenttab,childtab,            &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_LINEARCONSERVLIM) then !Linear conservative interpolation
+!
+        call Linear1dConservLim(parenttab,childtab,         &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    elseif (type_interp == Agrif_CONSTANT) then
+!
+        call Constant1d(parenttab,childtab,                 &
+                indmax-indmin+1,petab_child-pttab_child+1,  &
+                s_parent,s_child,ds_parent,ds_child)
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_InterpBase
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Find_list_interp
+!---------------------------------------------------------------------------------------------------
+function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     &
+                                    nbdim, indmin, indmax, indminglob,  indmaxglob,         &
+                                    pttruetab, cetruetab, memberin                          &
+#if defined AGRIF_MPI
+                                   ,indminglob2, indmaxglob2, parentarray,                  &
+                                    member, tab4t, memberinall, sendtoproc1, recvfromproc1  &
+#endif
+    ) result(find_list_interp)
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_List_Interp_Loc),   pointer     :: list_interp
+    integer,                       intent(in)  :: nbdim
+    integer, dimension(nbdim),     intent(in)  :: pttab, petab, pttab_Child, pttab_Parent
+    integer, dimension(nbdim),     intent(out) :: indmin, indmax
+    integer, dimension(nbdim),     intent(out) :: indminglob, indmaxglob
+    integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab
+    logical,                       intent(out) :: memberin
+#if defined AGRIF_MPI
+    integer, dimension(nbdim),     intent(out) :: indminglob2, indmaxglob2
+    integer, dimension(nbdim,2,2), intent(out) :: parentarray
+    logical,                       intent(out) :: member
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
+    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: memberinall
+    logical, dimension(0:Agrif_Nbprocs-1),         intent(out) :: sendtoproc1, recvfromproc1
+#endif
+    logical :: find_list_interp
+!
+    integer :: i
+    type(Agrif_List_Interp_Loc), pointer :: parcours
+    type(Agrif_Interp_Loc),      pointer :: pil
+
+    find_list_interp = .false.
+
+    if ( .not. associated(list_interp) )    return
+
+    parcours => list_interp
+    find_loop : do while ( associated(parcours) )
+
+        pil => parcours % interp_loc
+
+        do i = 1,nbdim
+            if ( (pttab(i) /= pil % pttab(i)) .or. &
+                 (petab(i) /= pil % petab(i)) .or. &
+                 (pttab_child(i)  /= pil % pttab_child(i)) .or. &
+                 (pttab_parent(i) /= pil % pttab_parent(i)) ) then
+                parcours => parcours % suiv
+                cycle find_loop
+            endif
+        enddo
+
+        indmin = pil % indmin(1:nbdim)
+        indmax = pil % indmax(1:nbdim)
+
+        pttruetab = pil % pttruetab(1:nbdim)
+        cetruetab = pil % cetruetab(1:nbdim)
+
+#if !defined AGRIF_MPI
+        indminglob  = pil % indminglob(1:nbdim)
+        indmaxglob  = pil % indmaxglob(1:nbdim)
+#else
+        indminglob  = pil % indminglob2(1:nbdim)
+        indmaxglob  = pil % indmaxglob2(1:nbdim)
+        indminglob2 = pil % indminglob2(1:nbdim)
+        indmaxglob2 = pil % indmaxglob2(1:nbdim)
+        parentarray = pil % parentarray(1:nbdim,:,:)
+        member      = pil % member
+        tab4t         = pil % tab4t(1:nbdim, 0:Agrif_Nbprocs-1, 1:8)
+        memberinall   = pil % memberinall(0:Agrif_Nbprocs-1)
+        sendtoproc1   = pil % sendtoproc1(0:Agrif_Nbprocs-1)
+        recvfromproc1 = pil % recvfromproc1(0:Agrif_Nbprocs-1)
+#endif
+        memberin = pil % memberin
+        find_list_interp = .true.
+        exit find_loop
+    enddo find_loop
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Find_list_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_AddTo_list_interp
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,  &
+                                     indmin, indmax, indminglob, indmaxglob,                &
+                                     pttruetab, cetruetab,                                  &
+                                     memberin, nbdim                                        &
+#if defined AGRIF_MPI
+                                    ,indminglob2, indmaxglob2,                              &
+                                     parentarray,                                           &
+                                     member,                                                &
+                                     tab4t, memberinall, sendtoproc1, recvfromproc1         &
+#endif
+    )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_List_Interp_Loc), pointer    :: list_interp
+    integer                                 :: nbdim
+    integer, dimension(nbdim)               :: pttab, petab, pttab_Child, pttab_Parent
+    integer, dimension(nbdim)               :: indmin,indmax
+    integer, dimension(nbdim)               :: indminglob, indmaxglob
+    integer, dimension(nbdim)               :: pttruetab, cetruetab
+    logical                                 :: memberin
+#if defined AGRIF_MPI
+    integer, dimension(nbdim,2,2)           :: parentarray
+    logical                                 :: member
+    integer, dimension(nbdim)                       :: indminglob2,indmaxglob2
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    logical, dimension(0:Agrif_Nbprocs-1)           :: memberinall
+    logical, dimension(0:Agrif_Nbprocs-1)           :: sendtoproc1
+    logical, dimension(0:Agrif_Nbprocs-1)           :: recvfromproc1
+#endif
+!
+    type(Agrif_List_Interp_Loc), pointer    :: parcours
+    type(Agrif_Interp_Loc),      pointer    :: pil
+!
+    allocate(parcours)
+    allocate(parcours % interp_loc)
+
+    pil => parcours % interp_loc
+
+    pil % pttab(1:nbdim) = pttab(1:nbdim)
+    pil % petab(1:nbdim) = petab(1:nbdim)
+    pil % pttab_child(1:nbdim) = pttab_child(1:nbdim)
+    pil % pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
+
+    pil % indmin(1:nbdim) = indmin(1:nbdim)
+    pil % indmax(1:nbdim) = indmax(1:nbdim)
+
+    pil % memberin = memberin
+#if !defined AGRIF_MPI
+    pil % indminglob(1:nbdim) = indminglob(1:nbdim)
+    pil % indmaxglob(1:nbdim) = indmaxglob(1:nbdim)
+#else
+    pil % indminglob2(1:nbdim) = indminglob2(1:nbdim)
+    pil % indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim)
+    pil % parentarray(1:nbdim,:,:) = parentarray(1:nbdim,:,:)
+    pil % member = member
+    allocate(pil % tab4t(nbdim, 0:Agrif_Nbprocs-1, 8))
+    allocate(pil % memberinall(0:Agrif_Nbprocs-1))
+    allocate(pil % sendtoproc1(0:Agrif_Nbprocs-1))
+    allocate(pil % recvfromproc1(0:Agrif_Nbprocs-1))
+    pil % tab4t         = tab4t
+    pil % memberinall   = memberinall
+    pil % sendtoproc1   = sendtoproc1
+    pil % recvfromproc1 = recvfromproc1
+#endif
+
+    pil % pttruetab(1:nbdim) = pttruetab(1:nbdim)
+    pil % cetruetab(1:nbdim) = cetruetab(1:nbdim)
+
+    parcours % suiv => list_interp
+    list_interp => parcours
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Addto_list_interp
+!===================================================================================================
+!
+end module Agrif_Interpolation
Index: vendors/AGRIF/AGRIF_FILES/modinterpbasic.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modinterpbasic.F90	(revision 9621)
@@ -0,0 +1,1464 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_InterpBasic
+!>
+!> Contains different procedures of interpolation (linear,lagrange, spline,...) used in
+!! the Agrif_Interpolation module.
+!
+module Agrif_InterpBasic
+!
+    use Agrif_Types
+!
+    implicit none
+!
+    real, dimension(5,Agrif_MaxRaff,3)      :: tabppm
+    real, dimension(Agrif_MaxRaff)          :: tabdiff2, tabdiff3
+    real, dimension(:),   allocatable       :: tabtest4
+    real, dimension(:,:), allocatable       :: coeffparent
+    integer, dimension(:,:), allocatable    :: indparent
+    integer, dimension(:,:), allocatable    :: indparentppm, indchildppm
+    integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d
+!
+    private :: Agrif_limiter_vanleer
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_basicinterp_linear1D
+!
+!> Linear 1D interpolation on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicinterp_linear1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(in)     :: x            !< Coarse input data from parent
+    real, dimension(nc), intent(out)    :: y            !< Fine output data to child
+    integer,             intent(in)     :: np           !< Length of input array
+    integer,             intent(in)     :: nc           !< Length of output array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+!
+    integer :: i, coeffraf, locind_parent_left
+    real    :: globind_parent_left, globind_parent_right
+    real    :: invds, invds2, ypos, ypos2, diff
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if ( coeffraf == 1 ) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    ypos = s_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    globind_parent_left  = s_parent + (locind_parent_left - 1)*ds_parent
+    globind_parent_right = globind_parent_left + ds_parent
+!
+    invds  = 1./ds_parent
+    invds2 = ds_child/ds_parent
+    ypos2 = ypos*invds
+    globind_parent_right = globind_parent_right*invds
+!
+    do i = 1,nc-1
+!
+        if (ypos2 > globind_parent_right) then
+            locind_parent_left = locind_parent_left + 1
+            globind_parent_right = globind_parent_right + 1.
+            ypos2 = ypos*invds+(i-1)*invds2
+        endif
+!
+        diff = globind_parent_right - ypos2
+        y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1))
+        ypos2 = ypos2 + invds2
+!
+    enddo
+!
+    ypos = s_child + (nc-1)*ds_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!
+    if (locind_parent_left == np) then
+        y(nc) = x(np)
+    else
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  &
+                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicinterp_linear1D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dPrecompute2d
+!
+!> Computes 2D coefficients and index for a linear 1D interpolation on a child grid (vector y)
+!! from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: np,nc,np2
+    real,    intent(in) :: s_parent, s_child
+    real,    intent(in) :: ds_parent, ds_child
+    integer, intent(in) :: dir
+!
+    integer :: i,coeffraf,locind_parent_left,inc,inc1,inc2
+    integer, dimension(:,:), allocatable :: indparent_tmp
+    real, dimension(:,:), allocatable :: coeffparent_tmp
+    real    :: ypos,globind_parent_left,globind_parent_right
+    real    :: invds, invds2, invds3
+    real :: ypos2,diff
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    ypos = s_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+    globind_parent_right = globind_parent_left + ds_parent
+!
+    invds = 1./ds_parent
+    invds2 = ds_child/ds_parent
+    invds3 = 0.5/real(coeffraf)
+    ypos2 = ypos*invds
+    globind_parent_right=globind_parent_right*invds
+!
+    if (.not.allocated(indparent)) then
+        allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+    else
+        if ( size(indparent,1) < nc*np2 ) then
+            allocate(coeffparent_tmp(size(indparent,1),size(indparent,2)))
+            allocate(  indparent_tmp(size(indparent,1),size(indparent,2)))
+            coeffparent_tmp = coeffparent
+            indparent_tmp   = indparent
+            deallocate(indparent,coeffparent)
+            allocate(indparent(nc*np2,3),coeffparent(nc*np2,3))
+            coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2)) = coeffparent_tmp
+            indparent(  1:size(indparent_tmp,  1),1:size(indparent_tmp,  2)) = indparent_tmp
+            deallocate(indparent_tmp,coeffparent_tmp)
+        endif
+    endif
+!
+    do i = 1,nc-1
+!
+        if (ypos2 > globind_parent_right) then
+            locind_parent_left = locind_parent_left + 1
+            globind_parent_right = globind_parent_right + 1.
+            ypos2 = ypos*invds+(i-1)*invds2
+        endif
+!
+        diff = globind_parent_right - ypos2
+        diff = invds3*nint(2*coeffraf*diff)
+        indparent(i,dir) = locind_parent_left
+        coeffparent(i,dir) = diff
+        ypos2 = ypos2 + invds2
+!
+    enddo
+!
+    ypos = s_child + (nc-1)*ds_child
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+
+    if (locind_parent_left == np) then
+        indparent(nc,dir) = locind_parent_left-1
+        coeffparent(nc,dir) = 0.
+    else
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+        indparent(nc,dir) = locind_parent_left
+        diff = (globind_parent_left + ds_parent - ypos) * invds
+        diff = invds3*nint(2*coeffraf*diff)
+        coeffparent(nc,dir) = diff
+    endif
+
+    do i=2, np2
+        inc  =  i*nc
+        inc1 = (i-1)*nc
+        inc2 = (i-2)*nc
+!CDIR ALTCODE
+        indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np
+!CDIR ALTCODE
+        coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dPrecompute2d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dAfterCompute
+!
+!> Carries out a linear 1D interpolation on a child grid (vector y) from its parent grid (vector x)
+!! using precomputed coefficient and index.
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dAfterCompute ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    integer,             intent(in)     :: dir
+!
+    integer :: i
+!
+!CDIR ALTCODE
+!CDIR NODEP
+    do i = 1,nc
+        y(i) = coeffparent(i,dir)  * x(MAX(indparent(i,dir),1)) + &
+           (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Lagrange1d
+!
+!> Carries out a lagrange 1D interpolation on a child grid (vector y) from its parent grid
+!! (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Lagrange1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i, coeffraf, locind_parent_left
+    real    :: ypos,globind_parent_left
+    real    :: deltax, invdsparent
+    real    :: t2,t3,t4,t5,t6,t7,t8
+!
+    if (np <= 2) then
+        call Agrif_basicinterp_linear1D(x,y,np,nc,s_parent,s_child,ds_parent,ds_child)
+        return
+    endif
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invdsparent = 1./ds_parent
+    ypos = s_child
+!
+    do i = 1,nc
+!
+        locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+        globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
+
+        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+
+        ypos = ypos + ds_child
+        if (abs(deltax) <= 0.0001) then
+            y(i)=x(locind_parent_left)
+            cycle
+        endif
+!
+        t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4
+
+        y(i) = t5*x(locind_parent_left-1) + t6*x(locind_parent_left)    &
+              +t7*x(locind_parent_left+1) + t8*x(locind_parent_left+2)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Lagrange1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Constant1d
+!
+!> Carries out a constant 1D interpolation on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Constant1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i, coeffraf, locind_parent
+    real    :: ypos
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent:locind_parent+nc-1)
+        return
+    endif
+!
+    ypos = s_child
+!
+    do i = 1,nc
+!
+        locind_parent = 1 + nint((ypos - s_parent)/ds_parent)
+        y(i) = x(locind_parent)
+        ypos = ypos + ds_child
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Constant1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dConserv
+!
+!> Carries out a conservative linear 1D interpolation on a child grid (vector y) from its parent 
+!! grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dConserv ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    integer :: i1,i2,ii
+    integer :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+
+    xdiffmod = real(diffmod)/2.
+
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    xpmax = s_parent + (locind_parent_last-1)*ds_parent
+
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+    i = i1
+
+    if (locind_parent_left == 1) then
+        slope = (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf)
+    else
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+    endif
+
+    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+
+    locind_parent_left = locind_parent_left + 1
+
+    do i = i1+coeffraf, i2-coeffraf,coeffraf
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+        do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+    enddo
+
+    i = i2
+
+    if (locind_parent_left == np) then
+        slope = (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf)
+    else
+        slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
+    endif
+
+    do ii = i-coeffraf/2+diffmod,nc
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+!
+    y(1:nc)=ytemp(1:nc)
+!
+    deallocate(ytemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dConserv
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Linear1dConservLim
+!
+!> Carries out a limited conservative linear 1D interpolation on a child grid (vector y) from
+!! its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine Linear1dConservLim ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    integer :: i1,i2,ii
+    integer :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    if (coeffraf /= 3) then
+        print *,'Linear1dConservLim not ready for refinement ratio = ', coeffraf
+        stop
+    endif
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+
+    xdiffmod = real(diffmod)/2.
+
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    xpmax = s_parent + (locind_parent_last-1)*ds_parent
+
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+    i2 = 1+agrif_int((xpmax-s_child)/ds_child)
+
+    i = i1
+
+    if (locind_parent_left == 1) then
+        slope=0.
+    else
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+    endif
+
+    do ii = i-coeffraf/2+diffmod,i+coeffraf/2
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+
+    locind_parent_left = locind_parent_left + 1
+
+    do i = i1+coeffraf, i2-coeffraf,coeffraf
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+        do ii=i-coeffraf/2+diffmod,i+coeffraf/2
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        enddo
+        locind_parent_left = locind_parent_left + 1
+    enddo
+
+    i = i2
+
+    if (locind_parent_left == np) then
+        slope=0.
+    else
+        slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1))
+        slope = slope / coeffraf
+    endif
+
+    do ii=i-coeffraf/2+diffmod,nc
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+!
+    deallocate(ytemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Linear1dConservLim
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1d
+!
+!> Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
+!! method (PPM) on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos,nmin,nmax
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin,a
+!
+    real, dimension(np) :: xl,delta,a6,slope
+    integer :: diffmod
+    real :: invcoeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    if( .not. allocated(tabtest4) ) then
+        allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+    else
+        if (size(tabtest4) < nc+4*coeffraf+1) then
+            deallocate( tabtest4 )
+            allocate(tabtest4(-2*coeffraf:nc+2*coeffraf))
+        endif
+    endif
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+!CDIR NOVECTOR
+    do i=1,coeffraf
+        tabdiff2(i) = (real(i)-0.5)*invcoeffraf
+    enddo
+!
+    a = invcoeffraf**2
+    tabdiff3(1) = (1./3.)*a
+    a = 2.*a
+!CDIR NOVECTOR
+    do i=2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+    enddo
+!
+    if      ( locind_parent_last+2 <= np ) then
+        nmax = locind_parent_last+2
+    else if ( locind_parent_last+1 <= np ) then
+        nmax = locind_parent_last+1
+    else
+        nmax = locind_parent_last
+    endif
+!
+    if (locind_parent_left-1 >= 1) then
+        nmin = locind_parent_left-1
+    else
+        nmin = locind_parent_left
+    endif
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = nmin,nmax
+        slope(i) = x(i) - x(i-1)
+    enddo
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = nmin+1,nmax-1
+        xl(i)= 0.5*(x(i-1)+x(i))-0.08333333333333*(slope(i+1)-slope(i-1))
+    enddo
+!
+! apply parabolic monotonicity
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    do i = locind_parent_left,locind_parent_last
+        delta(i) = xl(i+1) - xl(i)
+        a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1))
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+        do jj = ipos-coeffraf/2+diffmod,ipos+coeffraf/2
+!
+            tabtest4(jj) = xl(iparent) + tabdiff2(pos) *  (delta(iparent)+a6(iparent)) &
+                                       - tabdiff3(pos) *  a6(iparent)
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+    y(1:nc) = tabtest4(1:nc)
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1dPrecompute2d
+!
+!> Computes 2D coefficients and index for a 1D interpolation using piecewise parabolic method
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np2, np, nc
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+    integer,             intent(in)     :: dir
+!
+    integer, dimension(:,:), allocatable :: indparent_tmp
+    integer, dimension(:,:), allocatable :: indchild_tmp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin,a
+!
+    integer :: diffmod
+    real :: invcoeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    if (.not.allocated(indparentppm)) then
+        allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
+    else
+        if (size(indparentppm,1) < np2*nc) then
+            allocate(   &
+                indparent_tmp(size(indparentppm,1),size(indparentppm,2)), &
+                indchild_tmp( size(indparentppm,1),size(indparentppm,2)))
+            indparent_tmp = indparentppm
+            indchild_tmp  = indchildppm
+            deallocate(indparentppm,indchildppm)
+            allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3))
+            indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indparent_tmp
+            indchildppm( 1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indchild_tmp
+            deallocate(indparent_tmp,indchild_tmp)
+        endif
+    endif
+
+    if (.not.allocated(indparentppm_1d)) then
+        allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),    &
+                 indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
+    else
+        if (size(indparentppm_1d) < nc+4*coeffraf+1) then
+            deallocate(indparentppm_1d,indchildppm_1d)
+            allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),&
+                     indchildppm_1d( -2*coeffraf:nc+2*coeffraf))
+        endif
+    endif
+!
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    do i = 1,coeffraf
+        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+    enddo
+!
+    a = invcoeffraf**2
+    tabdiff3(1) = (1./3.)*a
+    a = 2.*a
+!CDIR ALTCODE
+    do i = 2,coeffraf
+        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+    enddo
+
+!CDIR ALTCODE
+    do i = 1,coeffraf
+        tabppm(1,i,dir) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+        tabppm(2,i,dir) = 0.08333333333333*(7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+        tabppm(3,i,dir) = 0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+        tabppm(4,i,dir) = 0.08333333333333*(-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+        tabppm(5,i,dir) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+!CDIR ALTCODE
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            indparentppm_1d(jj) = iparent-2
+            indchildppm_1d(jj)  = pos
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+    do i = 1,np2
+        indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np
+        indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1dPrecompute2d
+!===================================================================================================
+!
+!===================================================================================================
+!subroutine PPM1dPrecompute(np,nc,&
+!                    s_parent,s_child,ds_parent,ds_child)
+!!
+!!CC   Description:
+!!CC   subroutine to compute coefficient and index for  a 1D interpolation
+!!CC   using piecewise parabolic method
+!!C    Method:
+!!
+!!     Declarations:
+!!
+!      Implicit none
+!!
+!!     Arguments
+!      Integer             :: np,nc
+!!      Real, Dimension(:),Allocatable :: ytemp
+!      Real                :: s_parent,s_child,ds_parent,ds_child
+!!
+!!     Local scalars
+!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+!      Integer :: iparent,ipos,pos,nmin,nmax
+!      Real    :: ypos
+!      integer :: i1,jj
+!      Real :: xpmin,a
+!!
+!      Real :: xrmin,xrmax,am3,s2,s1
+!      Real, Dimension(np) :: xl,delta,a6,slope
+!!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+!      INTEGER :: diffmod
+!      REAL :: invcoeffraf
+!!
+!      coeffraf = nint(ds_parent/ds_child)
+!!
+!      If (coeffraf == 1) Then
+!          return
+!      End If
+!      invcoeffraf = ds_child/ds_parent
+!!
+!
+!      if (.not.allocated(indparentppm)) then
+!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
+!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+!      else
+!      if (size(indparentppm,1)<nc+4*coeffraf+1) then
+!      deallocate(indparentppm,indchildppm)
+!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
+!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
+!      endif
+!      endif
+!
+!      ypos = s_child
+!!
+!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!      locind_parent_last = 1 +&
+!      agrif_ceiling((ypos +(nc - 1)&
+!      *ds_child - s_parent)/ds_parent)
+!!
+!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!!
+!!
+!
+!      Do i=1,coeffraf
+!        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
+!      EndDo
+!
+!      a = invcoeffraf**2
+!      tabdiff3(1) = (1./3.)*a
+!      a=2.*a
+!!CDIR ALTCODE
+!!!!CDIR SHORTLOOP
+!      Do i=2,coeffraf
+!        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
+!      EndDo
+!
+!!CDIR ALTCODE
+!!!!CDIR SHORTLOOP
+!      Do i=1,coeffraf
+!      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
+!      tabppm(2,i,1) = 0.08333333333333*&
+!              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
+!      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
+!      tabppm(4,i,1) = 0.08333333333333*&
+!              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
+!      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
+!      End Do
+!!
+!!
+!        diffmod = 0
+!       IF (mod(coeffraf,2) == 0) diffmod = 1
+!!
+!        ipos = i1
+!!
+!        Do iparent = locind_parent_left,locind_parent_last
+!             pos=1
+!!CDIR ALTCODE
+!!CDIR SHORTLOOP
+!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!         indparentppm(jj,1) = iparent-2
+!         indchildppm(jj,1) = pos
+!               pos = pos+1
+!             End do
+!             ipos = ipos + coeffraf
+!!
+!        End do
+!
+!      Return
+!      End subroutine ppm1dprecompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine PPM1dAfterCompute
+!
+! Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic
+! method (PPM) on a child grid (vector y) from its parent grid (vector x).
+! Use precomputed coefficient and index.
+!---------------------------------------------------------------------------------------------------
+subroutine PPM1dAfterCompute ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    integer,             intent(in)     :: np, nc
+    integer,             intent(in)     :: dir
+!
+    integer :: i
+!
+    do i = 1,nc
+        y(i) = tabppm(1,indchildppm(i,dir),dir) * x(indparentppm(i,dir)  ) + &
+               tabppm(2,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+1) + &
+               tabppm(3,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+2) + &
+               tabppm(4,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+3) + &
+               tabppm(5,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+4)
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine PPM1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine weno1d
+!
+! Carries out a 1D interpolation and apply monotonicity constraints
+! using WENO method on a child grid (vector y) from its parent grid (vector x).
+!---------------------------------------------------------------------------------------------------
+!subroutine weno1dnew ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+!
+!CC   Description:
+!CC   subroutine to do a 1D interpolation and apply monotonicity constraints
+!CC   using piecewise parabolic method
+!CC   on a child grid (vector y) from its parent grid (vector x).
+!C    Method:
+!
+!     Declarations:
+!
+!      Implicit none
+!
+!     Arguments
+!      Integer             :: np,nc
+!      Real, Dimension(np) :: x
+!      Real, Dimension(nc) :: y
+!      Real, Dimension(:),Allocatable :: ytemp
+!      Real                :: s_parent,s_child,ds_parent,ds_child
+!
+!     Local scalars
+!      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+!      Integer :: iparent,ipos,pos,nmin,nmax
+!      Real    :: ypos
+!      integer :: i1,jj
+!      Real :: xpmin,cavg,a,b
+!
+!      Real :: xrmin,xrmax,am3,s2,s1
+!      Real, Dimension(np) :: xr,xl,delta,a6,slope,slope2,smooth
+!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
+!      INTEGER :: diffmod
+!      REAL :: invcoeffraf
+!      integer :: s,l,k
+!      integer :: etan, etap
+!      real :: delta0, delta1, delta2
+!      real :: epsilon
+!      parameter (epsilon = 1.D-8)
+!      real, dimension(:,:), allocatable :: ak, ck
+!
+!      coeffraf = nint(ds_parent/ds_child)
+!
+!      If (coeffraf == 1) Then
+!          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+!          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+!          return
+!      End If
+!      invcoeffraf = ds_child/ds_parent
+!      Allocate(ak(0:1,coeffraf))
+!      Allocate(ck(0:1,coeffraf))
+!
+!
+!      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+!      ypos = s_child
+!
+!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+!      locind_parent_last = 1 +&
+!      agrif_ceiling((ypos +(nc - 1)&
+!      *ds_child - s_parent)/ds_parent)
+!
+!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
+!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+!      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+!
+!      diff(1)=0.5*invcoeffraf
+!      do i=2,coeffraf
+!         diff(i) = diff(i-1)+invcoeffraf
+!      enddo
+!
+!      ak = 0.
+!      ck = 0.
+!
+!      do i=1,coeffraf
+!         do k=0,1
+!         do s=0,2
+!         do l=0,2
+!           if (l /= s) then
+!            ak(k,i) = ak(k,i)+(diff(i)-(k-l+1.))
+!           endif
+!         enddo
+!         enddo
+!         enddo
+!
+!         etap = 0
+!         etan = 0
+!         do k=0,1
+!          if (ak(k,i) > 0) then
+!            etap = etap+1
+!          else if (ak(k,i) < 0) then
+!            etan = etan + 1
+!          endif
+!         enddo
+!
+!         do k=0,1
+!           if (ak(k,i) == 0) then
+!            Ck(k,i) = 1.
+!           else if (ak(k,i) > 0) then
+!            Ck(k,i) = 1./(etap * ak(k,i))
+!           else
+!            Ck(k,i) = -1./(etan * ak(k,i))
+!           endif
+!         enddo
+!      enddo
+!
+!
+!      a = 0.
+!      b = invcoeffraf
+!      Do i=1,coeffraf
+!         diff2(i) = 0.5*(b*b - a*a)
+!         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+!         a = a + invcoeffraf
+!         b = b + invcoeffraf
+!      End do
+!
+!      if( locind_parent_last+2 <= np ) then
+!           nmax = locind_parent_last+2
+!      elseif( locind_parent_last+1 <= np ) then
+!           nmax = locind_parent_last+1
+!      else
+!           nmax = locind_parent_last
+!      endif
+!
+!      if(locind_parent_left-2 >= 1) then
+!          nmin = locind_parent_left-2
+!      elseif(locind_parent_left-1 >= 1) then
+!          nmin = locind_parent_left-1
+!      else
+!          nmin = locind_parent_left
+!      endif
+!
+!      Do i = nmin+1,nmax
+!         slope(i) = (x(i) - x(i-1))
+!      Enddo
+!      DO i=nmin+2,nmax
+!        smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)&
+!       +(slope(i)-slope(i-1))**2
+!      enddo
+!
+!        diffmod = 0
+!        IF (mod(coeffraf,2) == 0) diffmod = 1
+!
+!        ipos = i1
+!
+!        Do iparent = locind_parent_left,locind_parent_last
+!             pos=1
+!
+!            delta0=1./(epsilon+smooth(iparent  ))**3
+!            delta1=1./(epsilon+smooth(iparent+1))**3
+!            delta2=1./(epsilon+smooth(iparent+2))**3
+!
+!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!
+!               pos = pos+1
+!             End do
+!             ipos = ipos + coeffraf
+!
+!        End do
+!
+!
+!        y(1:nc)=ytemp(1:nc)
+!        deallocate(ytemp)
+!        deallocate(diff, diff2, diff3)
+!
+!        deallocate(ak,ck)
+!
+!      Return
+!      End subroutine weno1dnew
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine WENO1d
+!
+!> Carries out a a 1D interpolation using WENO method on a child grid (vector y) from its parent 
+!! grid (vector x).
+!---------------------------------------------------------------------------------------------------
+subroutine WENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    real, dimension(:), allocatable :: ytemp
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: iparent,ipos,pos,nmin,nmax
+    real    :: ypos
+    integer :: i1,jj
+    real :: xpmin
+!
+    real, dimension(np) :: slope
+    real, dimension(:), allocatable  :: diff
+    integer :: diffmod
+    real :: invcoeffraf
+    real :: delta0, delta1, sumdelta
+    real, parameter :: epsilon = 1.d-8
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    endif
+!
+    invcoeffraf = ds_child/ds_parent
+!
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    allocate(diff(coeffraf))
+    diff(1) = 0.5*invcoeffraf
+    do i = 2,coeffraf
+        diff(i) = diff(i-1)+invcoeffraf
+    enddo
+!
+    if ( locind_parent_last+2 <= np ) then
+        nmax = locind_parent_last+2
+    else if ( locind_parent_last+1 <= np ) then
+        nmax = locind_parent_last+1
+      else
+        nmax = locind_parent_last
+    endif
+!
+    if(locind_parent_left-1 >= 1) then
+        nmin = locind_parent_left-1
+    else
+        nmin = locind_parent_left
+    endif
+!
+    do i = nmin+1,nmax
+        slope(i) = x(i) - x(i-1)
+    enddo
+!
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    ipos = i1
+!
+    do iparent = locind_parent_left,locind_parent_last
+        pos=1
+        delta0 = 1./(epsilon+slope(iparent  )**2)**2
+        delta1 = 1./(epsilon+slope(iparent+1)**2)**2
+        sumdelta = 1./(delta0+delta1)
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            ytemp(jj) = x(iparent)+(diff(pos)-0.5)*( delta0*slope(iparent) + &
+                                                     delta1*slope(iparent+1))*sumdelta
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+    deallocate(ytemp)
+    deallocate(diff)
+!---------------------------------------------------------------------------------------------------
+end subroutine WENO1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ENO1d
+!
+!> Carries out a 1D interpolation using piecewise polynomial ENO reconstruction technique
+!! on a child grid (vector y) from its parent grid (vector x).
+!! \see ---- p 163-164 Computational gasdynamics ----
+!---------------------------------------------------------------------------------------------------
+subroutine ENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
+    real, dimension(np), intent(in)     :: x
+    real, dimension(nc), intent(out)    :: y
+    real,                intent(in)     :: s_parent, s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!
+    integer :: i,coeffraf,locind_parent_left,locind_parent_last
+    integer :: ipos, pos
+    real    :: ypos,xi
+    integer :: i1,jj
+    real :: xpmin
+!
+    real, dimension(:),   allocatable  :: ytemp
+    real, dimension(:,:), allocatable  :: xbar
+    real, dimension(1:np+1)            :: xhalf
+    real, dimension(3,np)              :: dd, c
+    integer :: diffmod, left
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    if (coeffraf == 1) then
+        locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+        y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+        return
+    end if
+
+    diffmod = 0
+    if (mod(coeffraf,2) == 0) diffmod = 1
+!
+    allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+    ypos = s_child
+!
+    locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
+    locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent)
+!
+    xpmin = s_parent + (locind_parent_left-1)*ds_parent
+    i1 = 1+agrif_int((xpmin-s_child)/ds_child)
+!
+    do i = 1,np+1
+        xhalf(i) = i - 0.5
+    enddo
+!
+! Compute divided differences
+!
+    dd(1,1:np)   = x(1:np)
+    dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) )
+    dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) )
+!
+    allocate( xbar( coeffraf,2 ) )
+    xi = 0.5
+    do i = 1,coeffraf
+        xbar(i,1) = (i-1)*ds_child/ds_parent - xi
+        xbar(i,2) =  i   *ds_child/ds_parent - xi
+    enddo
+!
+    ipos = i1
+!
+    do i = locind_parent_left,locind_parent_last
+        left = i
+        do jj = 2,3
+            if(abs(dd(jj,left)) > abs(dd(jj,left-1))) left = left-1
+        enddo
+!
+!       convert to Taylor series form
+        call taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i))
+    enddo
+!
+! Evaluate the reconstruction on each cell
+!
+    do i = locind_parent_left,locind_parent_last
+!
+        pos = 1
+!
+        do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+            ytemp(jj) = ( c(1,i)*(xbar(pos,2)-xbar(pos,1))              &
+                        + c(2,i)*(xbar(pos,2)*xbar(pos,2) -             &
+                                  xbar(pos,1)*xbar(pos,1))              &
+                        + c(3,i)*(xbar(pos,2)*xbar(pos,2)*xbar(pos,2) - &
+                                  xbar(pos,1)*xbar(pos,1)*xbar(pos,1))  &
+                        ) * coeffraf
+            pos = pos+1
+        enddo
+        ipos = ipos + coeffraf
+!
+    enddo
+!
+    y(1:nc) = ytemp(1:nc)
+    deallocate(ytemp,xbar)
+!---------------------------------------------------------------------------------------------------
+end subroutine ENO1d
+!===================================================================================================
+!
+!     **************************************************************************  
+!CC   Subroutine ppm1d_lim
+!     ************************************************************************** 
+! 
+      Subroutine ppm1d_lim(x,y,np,nc,s_parent,s_child,ds_parent,ds_child) 
+!
+!CC   Description:
+!CC   Subroutine to do a 1D interpolation and apply monotonicity constraints
+!CC   using piecewise parabolic method  
+!CC   on a child grid (vector y) from its parent grid (vector x).
+!C    Method:
+!
+!     Declarations:
+!
+      Implicit none
+!        
+!     Arguments
+      Integer             :: np,nc      
+      Real, Dimension(np) :: x      
+      Real, Dimension(nc) :: y
+      Real, Dimension(:),Allocatable :: ytemp
+      Real                :: s_parent,s_child,ds_parent,ds_child
+!
+!     Local scalars
+      Integer :: i,coeffraf,locind_parent_left,locind_parent_last
+      Integer :: iparent,ipos,pos,nmin,nmax
+      Real    :: ypos
+      integer :: i1,jj
+      Real :: xpmin,cavg,a,b
+!      
+      Real :: xrmin,xrmax,am3,s2,s1  
+      Real, Dimension(np) :: dela,xr,xl,delta,a6,slope,slope2
+      Real, Dimension(:),Allocatable  :: diff,diff2,diff3    
+      INTEGER :: diffmod
+!      
+      coeffraf = nint(ds_parent/ds_child)
+!
+      If (coeffraf == 1) Then
+          locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent)
+          y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1)
+          return
+      End If
+!      
+      Allocate(ytemp(-2*coeffraf:nc+2*coeffraf))
+      ypos = s_child  
+!
+      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) 
+      locind_parent_last = 1 + &
+           agrif_ceiling((ypos +(nc - 1)  &
+           *ds_child - s_parent)/ds_parent)  
+!
+      xpmin = s_parent + (locind_parent_left-1)*ds_parent       
+      i1 = 1+agrif_int((xpmin-s_child)/ds_child)        
+!     
+      Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) )
+!      
+         diff(:) = ds_child/ds_parent
+!      
+      Do i=1,coeffraf
+         a = real(i-1)*ds_child/ds_parent
+         b = real(i)*ds_child/ds_parent
+         diff2(i) = 0.5*(b*b - a*a)  
+         diff3(i) = (1./3.)*(b*b*b - a*a*a)
+      End do
+!
+      if( locind_parent_last+2 <= np ) then
+           nmax = locind_parent_last+2    
+      else if( locind_parent_last+1 <= np ) then
+           nmax = locind_parent_last+1
+      else
+           nmax = locind_parent_last 
+      endif     
+!      
+      if(locind_parent_left-1 >= 1) then
+          nmin = locind_parent_left-1
+      else 
+          nmin = locind_parent_left
+      endif    
+! 
+      Do i = nmin,nmax
+         slope(i) = x(i) - x(i-1)
+         slope2(i) = 2.*abs(slope(i))
+      Enddo
+!
+      Do i = nmin,nmax-1
+         dela(i) = 0.5 * ( slope(i) + slope(i+1) )
+! Van Leer slope limiter
+         dela(i) = min( abs(dela(i)),slope2(i), &
+                       slope2(i+1) )*sign(1.,dela(i))
+         IF( slope(i)*slope(i+1) <= 0. ) dela(i) = 0.
+      Enddo
+!
+      Do i = nmin,nmax-2
+         xr(i) = x(i) + (1./2.)*slope(i+1) + (-1./6.)*dela(i+1) &
+                                          + ( 1./6. )*dela(i)
+      Enddo
+!
+      Do i = nmin,nmax-2
+         xrmin = min(x(i),x(i+1))
+         xrmax = max(x(i),x(i+1))
+         xr(i) = min(xr(i),xrmax)
+         xr(i) = max(xr(i),xrmin)
+         xl(i+1) = xr(i)         
+      Enddo
+! apply parabolic monotonicity
+       Do i = locind_parent_left,locind_parent_last
+          If( ( (xr(i)-x(i))* (x(i)-xl(i)) ) .le. 0. ) then
+             xl(i) = x(i) 
+             xr(i) = x(i)
+          Endif          
+          delta(i) = xr(i) - xl(i)
+          am3 = 3. * x(i)
+          s1  = am3 - 2. * xr(i)
+          s2  = am3 - 2. * xl(i)
+          IF( delta(i) * (xl(i) - s1) .le. 0. ) xl(i) = s1
+          IF( delta(i) * (s2 - xr(i)) .le. 0. ) xr(i) = s2
+          delta(i) = xr(i) - xl(i)
+          a6(i) = 6.*x(i)-3.*(xl(i) +xr(i))
+!
+       End do   
+!
+        diffmod = 0
+       IF (mod(coeffraf,2) == 0) diffmod = 1           
+!
+        ipos = i1
+!               
+        Do iparent = locind_parent_left,locind_parent_last       
+             pos=1
+             cavg = 0.
+             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
+!
+               ytemp(jj) = (diff(pos)*xl(iparent)   &
+                  + diff2(pos) &
+                  *  (delta(iparent)+a6(iparent)) &
+                  - diff3(pos)*a6(iparent))*coeffraf
+                              
+               cavg = cavg + ytemp(jj)
+               pos = pos+1 
+             End do 
+             ipos = ipos + coeffraf
+!
+        End do     
+!
+!
+        y(1:nc)=ytemp(1:nc)                                 
+        deallocate(ytemp)                
+        deallocate(diff, diff2, diff3)
+      Return
+      End Subroutine ppm1d_lim
+!===================================================================================================
+!  subroutine taylor
+!---------------------------------------------------------------------------------------------------
+subroutine taylor ( ind, xhalf, dd, c )
+!---------------------------------------------------------------------------------------------------
+    integer,            intent(in)  :: ind
+    real, dimension(3), intent(in)  :: xhalf
+    real, dimension(3), intent(in)  :: dd
+    real, dimension(3), intent(out) :: c
+!
+    real, dimension(0:3,0:3) :: d
+    integer                  :: i, j
+!
+    d(0,0:3) = 1.0
+    do i = 1,3
+        d(i,0) = (ind-xhalf(i))*d(i-1,0)
+    enddo
+!
+    do i = 1,3
+        do j = 1,3-i
+            d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j)
+        enddo
+    enddo
+!
+    do j = 1,3
+        c(j) = 0.
+        do i=0,3-j
+            c(j) = c(j) + d(i,j)*dd(i+j)
+        enddo
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine taylor
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_limiter_vanleer
+!---------------------------------------------------------------------------------------------------
+real function Agrif_limiter_vanleer ( tab ) result(res)
+!---------------------------------------------------------------------------------------------------
+    real, dimension(3), intent(in) :: tab
+!
+    real :: p1, p2, p3
+
+    p1 =    (tab(3)-tab(1))/2.
+    p2 = 2.*(tab(2)-tab(1))
+    p3 = 2.*(tab(3)-tab(2))
+
+    if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then
+        res = minval((/p1,p2,p3/))
+    elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then
+        res = maxval((/p1,p2,p3/))
+    else
+        res=0.
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_limiter_vanleer
+!===================================================================================================
+!
+end module Agrif_InterpBasic
Index: vendors/AGRIF/AGRIF_FILES/modlinktomodel.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modlinktomodel.F90	(revision 9621)
@@ -0,0 +1,181 @@
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Link
+!>
+!> This module is used to link AGRIF files to the model.
+!
+module Agrif_Link
+!
+    interface
+!
+        subroutine Agrif_clustering_def ( )
+!
+        end subroutine Agrif_clustering_def
+!
+        subroutine Agrif_Set_numberofcells ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine Agrif_Set_numberofcells
+!
+        subroutine Agrif_Get_numberofcells ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine Agrif_Get_numberofcells
+!
+    end interface
+!
+    abstract interface
+!
+        subroutine alloc_proc ( Agrif_Gr )
+            use Agrif_Grids, only : Agrif_Grid
+            type(Agrif_Grid), pointer :: Agrif_Gr   !< Pointer on the current grid
+        end subroutine alloc_proc
+!
+        subroutine typedef_proc ( )
+            implicit none
+        end subroutine typedef_proc
+!
+    end interface
+    
+    procedure(alloc_proc)   :: Agrif_Allocationcalls
+    procedure(typedef_proc) :: Agrif_probdim_modtype_def
+!
+end module Agrif_Link
+!
+!===================================================================================================
+!  function Agrif_parent
+!        modify by conv. To use : un_parent = Agrif_Parent(un)
+!===================================================================================================
+!  function Agrif_Get_Coarse_Grid
+!        modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un)
+!===================================================================================================
+!  function Agrif_Rhox
+!        modify by conv. To use : var = Agrif_Rhox()
+!                    REAL(Agrif_Curgrid % spaceref(1))
+!===================================================================================================
+!  function Agrif_Parent_Rhox
+!        modify by conv. To use : var = Agrif_Parent_Rhox()
+!                    REAL(Agrif_Curgrid % parent % spaceref(1))
+!===================================================================================================
+!  function Agrif_Irhox
+!        modify by conv. To use : var = Agrif_Parent_IRhox()
+!                    Agrif_Curgrid % spaceref(1)
+!===================================================================================================
+!  function Agrif_Parent_Irhox
+!        modify by conv. To use : var = Agrif_Parent_IRhox()
+!                    Agrif_Curgrid % parent % spaceref(1)
+!===================================================================================================
+!  function Agrif_Rhoy
+!        modify by conv. To use : var = Agrif_Rhoy()
+!                    REAL(Agrif_Curgrid % spaceref(2))
+!===================================================================================================
+!  function Agrif_Parent_Rhoy
+!        modify by conv. To use : var = Agrif_Parent_Rhoy()
+!                    REAL(Agrif_Curgrid % parent % spaceref(2))
+!===================================================================================================
+!  function Agrif_Irhoy
+!        modify by conv. To use : var = Agrif_Parent_IRhoy()
+!                    Agrif_Curgrid % spaceref(2)
+!===================================================================================================
+!  function Agrif_Parent_Irhoy
+!        modify by conv. To use : var = Agrif_Parent_IRhoy()
+!                    Agrif_Curgrid % parent % spaceref(2)
+!===================================================================================================
+!  function Agrif_Rhoz
+!        modify by conv. To use : var = Agrif_Rhoz()
+!                    REAL(Agrif_Curgrid % spaceref(3))
+!===================================================================================================
+!  function Agrif_Parent_Rhoz
+!        modify by conv. To use : var = Agrif_Parent_Rhoz()
+!                    REAL(Agrif_Curgrid % parent % spaceref(3))
+!===================================================================================================
+!  function Agrif_Irhoz
+!        modify by conv. To use : var = Agrif_Parent_IRhoz()
+!                    Agrif_Curgrid % spaceref(3)
+!===================================================================================================
+!  function Agrif_Parent_Irhoz
+!        modify by conv. To use : var = Agrif_Parent_IRhoz()
+!                    Agrif_Curgrid % parent % spaceref(3)
+!===================================================================================================
+!  function Agrif_NearCommonBorderX
+!        modify by conv. To use : var = Agrif_NearCommonBorderX()
+!                       Agrif_Curgrid % NearRootBorder(1)
+!===================================================================================================
+!  function Agrif_NearCommonBorderY
+!        modify by conv. To use : var = Agrif_NearCommonBorderY()
+!                       Agrif_Curgrid % NearRootBorder(2)
+!===================================================================================================
+!  function Agrif_NearCommonBorderZ
+!        modify by conv. To use : var = Agrif_NearCommonBorderZ()
+!                       Agrif_Curgrid % NearRootBorder(3)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderX
+!        modify by conv. To use : var = Agrif_DistantCommonBorderX()
+!                       Agrif_Curgrid % DistantRootBorder(1)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderY
+!        modify by conv. To use : var = Agrif_DistantCommonBorderY()
+!                       Agrif_Curgrid % DistantRootBorder(2)
+!===================================================================================================
+!  function Agrif_DistantCommonBorderZ
+!        modify by conv. To use : var = Agrif_DistantCommonBorderZ()
+!                       Agrif_Curgrid % DistantRootBorder(3)
+!===================================================================================================
+!  function Agrif_Nb_Step
+!        modify by conv. To use : var = Agrif_Nb_Step()
+!                          Agrif_Curgrid % ngridstep
+!===================================================================================================
+!  function Agrif_Nb_Fine_Grids
+!        modify by conv. To use : var = Agrif_Nb_Fine_Grids()
+!                         Agrif_nbfixedgrids
+!===================================================================================================
+!  function Agrif_Ix
+!        modify by conv. To use : var = Agrif_Ix()
+!                         Agrif_Curgrid % ix(1)
+!===================================================================================================
+!  function Agrif_Parent_Ix
+!        modify by conv. To use : var = Agrif_Parent_Ix()
+!                        Agrif_Curgrid % parent % ix(1)
+!===================================================================================================
+!  function Agrif_Iy
+!        modify by conv. To use : var = Agrif_Iy()
+!                        Agrif_Curgrid % ix(2)
+!===================================================================================================
+!  function Agrif_Parent_Iy
+!        modify by conv. To use : var = Agrif_Parent_Iy()
+!                       Agrif_Curgrid % parent % ix(2)
+!===================================================================================================
+!  function Agrif_Iz
+!        modify by conv. To use : var = Agrif_Iz()
+!                      Agrif_Curgrid % ix(3)
+!===================================================================================================
+!  function Agrif_Parent_Iz
+!        modify by conv. To use : var = Agrif_Parent_Iz()
+!                     Agrif_Curgrid % parent % ix(3)
+!===================================================================================================
+!  function Agrif_Get_grid_id
+!        modify by conv. To use : var = Agrif_Get_grid_id()
+!                    Agrif_Curgrid % grid_id
+!===================================================================================================
+!  function Agrif_Get_parent_id
+!        modify by conv. To use : var = Agrif_Get_parent_id()
+!                    Agrif_Curgrid % parent % grid_id
+!===================================================================================================
Index: vendors/AGRIF/AGRIF_FILES/modmask.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modmask.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modmask.F90	(revision 9621)
@@ -0,0 +1,586 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Mask.
+!>
+!> Module for masks.
+!
+module Agrif_Mask
+!
+    use Agrif_Types
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_CheckMasknD
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
+    type(Agrif_Variable), pointer   :: parent !< The parent grid
+    integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
+    integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
+    integer, dimension(nbdim)       :: ppbtab, ppetab
+    logical, dimension(nbdim)       :: noraftab
+    integer                         :: nbdim
+!
+    integer :: i0,j0,k0,l0,m0,n0
+!
+    select case (nbdim)
+    case (1)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array1(i0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0/),tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+    case (2)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array2(i0,j0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0/),tempP,parent,ppbtab,ppetab, noraftab,nbdim)
+            endif
+        enddo
+        enddo
+    case (3)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array3(i0,j0,k0) == Agrif_SpecialValue) then
+!------CDIR NEXPAND
+                call CalculNewValTempP3D((/i0,j0,k0/), &
+                    tempP%array3(ppbtab(1),ppbtab(2),ppbtab(3)),  &
+                    parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+
+!            Call CalculNewValTempP((/i0,j0,k0/),
+!     &                             tempP,parent,
+!     &                             ppbtab,ppetab,
+!     &                             noraftab,nbdim)
+
+            endif
+        enddo
+        enddo
+        enddo
+    case (4)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
+                call CalculNewValTempP4D((/i0,j0,k0,l0/), &
+                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
+                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+    case (5)
+        do m0 = pbtab(5),petab(5)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array5(i0,j0,k0,l0,m0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0,k0,l0,m0/), &
+                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    case (6)
+        do n0 = pbtab(6),petab(6)
+        do m0 = pbtab(5),petab(5)
+        do l0 = pbtab(4),petab(4)
+        do k0 = pbtab(3),petab(3)
+        do j0 = pbtab(2),petab(2)
+        do i0 = pbtab(1),petab(1)
+            if (tempP%array6(i0,j0,k0,l0,m0,n0) == Agrif_SpecialValue) then
+                call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/), &
+                    tempP,parent,ppbtab,ppetab,noraftab,nbdim)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+        enddo
+    end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CheckMasknD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP ( indic, tempP, parent, ppbtab, ppetab, noraftab, nbdim )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim)       :: indic
+    type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
+    type(Agrif_Variable), pointer   :: parent !< The parent grid
+    integer, dimension(nbdim)       :: ppbtab, ppetab
+    logical, dimension(nbdim)       :: noraftab
+    integer                         :: nbdim
+!
+    integer                     :: i,ii,iii,jj,kk,ll,mm,nn
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: nbvals
+    real                        :: res
+    real                        :: valparent
+    integer                     :: ValMax
+    logical                     :: firsttest
+!
+    ValMax = 1
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+!CDIR NOVECTOR
+    imin = indic
+!CDIR NOVECTOR
+    imax = indic
+!
+    i = 1
+    firsttest = .TRUE.
+!
+    do while (i <= ValMax)
+!
+        if ( (i == 1).AND.(firsttest) ) i = Valmax
+!
+        do iii = 1,nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+!CDIR NOVECTOR
+                        idecal = indic
+                        idecal(iii) = idecal(iii)-1
+                        SELECT CASE(nbdim)
+                        CASE (1)
+                            if (tempP%array1(idecal(1) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (2)
+                            if (tempP%array2(idecal(1), idecal(2) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (3)
+                            if (tempP%array3(idecal(1), &
+                                             idecal(2), idecal(3) &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (4)
+                            if (tempP%array4(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4)  &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (5)
+                            if (tempP%array5(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4), &
+                                             idecal(5)             &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        CASE (6)
+                            if (tempP%array6(idecal(1), idecal(2), &
+                                             idecal(3), idecal(4), &
+                                             idecal(5), idecal(6)  &
+                                    ) == Agrif_SpecialValue) imin(iii) = imax(iii)
+                        END SELECT
+                    endif
+                endif
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        SELECT CASE(nbdim)
+        CASE (1)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array1(ii)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+!
+        CASE (2)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array2(ii,jj)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+
+        CASE (3)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array3(ii,jj,kk)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+
+        CASE (4)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array4(ii,jj,kk,ll)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+
+        CASE (5)
+            do mm = imin(5),imax(5)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array5(ii,jj,kk,ll,mm)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+
+        CASE (6)
+            do nn = imin(6),imax(6)
+            do mm = imin(5),imax(5)
+            do ll = imin(4),imax(4)
+            do kk = imin(3),imax(3)
+            do jj = imin(2),imax(2)
+!CDIR ALTCODE
+!CDIR SHORTLOOP
+            do ii = imin(1),imax(1)
+                ValParent = parent%array6(ii,jj,kk,ll,mm,nn)
+                if ( ValParent /= Agrif_SpecialValue) then
+                    Res = Res + ValParent
+                    Nbvals = Nbvals + 1
+                endif
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+            enddo
+
+        END SELECT
+!
+        if (Nbvals > 0) then
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
+            SELECT CASE(nbdim)
+            CASE (1)
+                tempP%array1(indic(1))           = Res/Nbvals
+            CASE (2)
+                tempP%array2(indic(1), indic(2)) = Res/Nbvals
+            CASE (3)
+                tempP%array3(indic(1), indic(2), &
+                             indic(3))           = Res/Nbvals
+            CASE (4)
+                tempP%array4(indic(1), indic(2), &
+                             indic(3), indic(4)) = Res/Nbvals
+            CASE (5)
+                tempP%array5(indic(1), indic(2), &
+                             indic(3), indic(4), &
+                             indic(5))           = Res/Nbvals
+            CASE (6)
+                tempP%array6(indic(1), indic(2), &
+                             indic(3), indic(4), &
+                             indic(5), indic(6)) = Res/Nbvals
+            END SELECT
+            exit
+        else
+            if (firsttest) exit
+            i = i + 1
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP3D
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP3D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
+                                 MaxSearch, Agrif_SpecialValue )
+!---------------------------------------------------------------------------------------------------
+    integer, parameter          :: nbdim = 3
+    integer, dimension(nbdim)   :: indic
+    integer, dimension(nbdim)   :: ppbtab, ppetab
+    logical, dimension(nbdim)   :: noraftab
+    integer                     :: MaxSearch
+    real                        :: Agrif_SpecialValue
+    real, dimension(ppbtab(1):ppetab(1), &
+                    ppbtab(2):ppetab(2), &
+                    ppbtab(3):ppetab(3)) &
+                                :: tempP, parent  !< Part of the parent grid used for
+                                                  !< the interpolation of the child grid
+!
+    integer                     :: i,ii,iii,jj,kk
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: Nbvals
+    real                        :: Res
+    real                        :: ValParent
+    integer                     :: ValMax
+    logical                     :: Existunmasked
+!
+    ValMax = 1
+!CDIR NOVECTOR
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+!CDIR NOVECTOR
+    imin = indic
+!CDIR NOVECTOR
+    imax = indic
+
+!CDIR NOVECTOR
+    idecal = indic
+    i = Valmax
+!
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            imin(iii) = max(indic(iii) - i,ppbtab(iii))
+            imax(iii) = min(indic(iii) + i,ppetab(iii))
+
+            if (indic(iii) > ppbtab(iii)) then
+                idecal(iii) = idecal(iii)-1
+                if (tempP(idecal(1),idecal(2),idecal(3)) == Agrif_SpecialValue) then
+                    imin(iii) = imax(iii)
+                endif
+                idecal(iii) = idecal(iii)+1
+            endif
+        endif
+    enddo
+!
+    Existunmasked = .FALSE.
+!
+    do kk = imin(3),imax(3)
+    do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+    do ii = imin(1),imax(1)
+        if ( parent(ii,jj,kk) /= Agrif_SpecialValue) then
+            Existunmasked = .TRUE.
+            exit
+        endif
+    enddo
+    enddo
+    enddo
+!
+    if (.Not.Existunmasked) return
+!
+    i = 1
+!
+    do while(i <= ValMax)
+!
+        do iii = 1 , nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        do kk = imin(3),imax(3)
+        do jj = imin(2),imax(2)
+!CDIR NOVECTOR
+        do ii = imin(1),imax(1)
+            ValParent = parent(ii,jj,kk)
+            if ( ValParent /= Agrif_SpecialValue) then
+                Res = Res + ValParent
+                Nbvals = Nbvals + 1
+            endif
+        enddo
+        enddo
+        enddo
+!
+        if (Nbvals > 0) then
+            tempP(indic(1),indic(2),indic(3)) = Res/Nbvals
+            exit
+        else
+            i = i + 1
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP3D
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine CalculNewValTempP4D
+!
+!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable
+!! when this one is equal to Agrif_SpecialValue.
+!---------------------------------------------------------------------------------------------------
+subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
+                                 MaxSearch, Agrif_SpecialValue )
+!---------------------------------------------------------------------------------------------------
+    integer, parameter          :: nbdim = 4
+    integer, dimension(nbdim)   :: indic
+    integer, dimension(nbdim)   :: ppbtab, ppetab
+    logical, dimension(nbdim)   :: noraftab
+    integer                     :: MaxSearch
+    real                        :: Agrif_SpecialValue
+    real, dimension(ppbtab(1):ppetab(1), &
+                    ppbtab(2):ppetab(2), &
+                    ppbtab(3):ppetab(3), &
+                    ppbtab(4):ppetab(4)) &
+                                :: tempP, parent  !< Part of the parent grid used for
+                                                  !< the interpolation of the child grid
+!
+    integer                     :: i,ii,iii,jj,kk,ll
+    integer, dimension(nbdim)   :: imin,imax,idecal
+    integer                     :: Nbvals
+    real                        :: Res
+    real                        :: ValParent
+    integer                     :: ValMax
+!
+    logical                     :: firsttest
+!
+    ValMax = 1
+    do iii = 1,nbdim
+        if (.NOT.noraftab(iii)) then
+            ValMax = max(ValMax,ppetab(iii)-indic(iii))
+            ValMax = max(ValMax,indic(iii)-ppbtab(iii))
+        endif
+    enddo
+!
+    Valmax = min(Valmax,MaxSearch)
+!
+    imin = indic
+    imax = indic
+!
+    i = 1
+    firsttest = .TRUE.
+    idecal = indic
+!
+    do while (i <= ValMax)
+!
+        if ((i == 1).AND.(firsttest)) i = Valmax
+
+        do iii = 1,nbdim
+            if (.NOT.noraftab(iii)) then
+                imin(iii) = max(indic(iii) - i,ppbtab(iii))
+                imax(iii) = min(indic(iii) + i,ppetab(iii))
+                if (firsttest) then
+                    if (indic(iii) > ppbtab(iii)) then
+                        idecal(iii) = idecal(iii)-1
+                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
+                            imin(iii) = imax(iii)
+                        endif
+                        idecal(iii) = idecal(iii)+1
+                    endif
+                endif
+            endif
+        enddo
+!
+        Res = 0.
+        Nbvals = 0
+!
+        do ll = imin(4),imax(4)
+        do kk = imin(3),imax(3)
+        do jj = imin(2),imax(2)
+        do ii = imin(1),imax(1)
+            ValParent = parent(ii,jj,kk,ll)
+            if ( ValParent /= Agrif_SpecialValue) then
+                Res = Res + ValParent
+                Nbvals = Nbvals + 1
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+!
+        if (Nbvals > 0) then
+            if (firsttest) then
+                firsttest = .FALSE.
+                i=1
+                cycle
+            endif
+
+            tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+            exit
+        else
+            if (firsttest) exit
+            i = i + 1
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine CalculNewValTempP4D
+!===================================================================================================
+!
+end module Agrif_Mask
Index: vendors/AGRIF/AGRIF_FILES/modmpp.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modmpp.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modmpp.F90	(revision 9621)
@@ -0,0 +1,634 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+module Agrif_Mpp
+!
+    use Agrif_Arrays
+    use Agrif_Grids
+!
+    implicit none
+!
+    interface
+        subroutine Agrif_get_proc_info ( imin, imax, jmin, jmax )
+            integer, intent(out) :: imin, imax
+            integer, intent(out) :: jmin, jmax
+        end subroutine Agrif_get_proc_info
+    end interface
+!
+    integer, private :: Agrif_MPI_prec
+!
+    private :: Agrif_get_proc_info
+!
+contains
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_MPI_Init
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_MPI_Init ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, optional, intent(in) :: comm    !< MPI communicator to be attached to the root grid.
+!
+    include 'mpif.h'
+    integer :: code, ierr
+    logical :: mpi_was_called
+    integer :: current_mpi_prec
+!
+    call MPI_INITIALIZED( mpi_was_called, code )
+    if( code /= MPI_SUCCESS ) then
+        write(*,*) ': Error in routine mpi_initialized'
+        call MPI_ABORT( MPI_COMM_WORLD, code, ierr )
+    endif
+    if( .not. mpi_was_called ) then
+        write(*,*) '### AGRIF Error : you should call Agrif_MPI_Init *after* MPI_Init.'
+        stop
+    endif
+
+    current_mpi_prec = KIND(1.0)
+    if (current_mpi_prec == 4) then
+      Agrif_MPI_prec = MPI_REAL4
+    else
+      Agrif_MPI_prec = MPI_REAL8
+    endif
+!
+    if ( present(comm) ) then
+        call Agrif_MPI_switch_comm(comm)
+    else
+        call Agrif_MPI_switch_comm(MPI_COMM_WORLD)
+    endif
+!
+    Agrif_Mygrid % communicator = Agrif_mpi_comm
+!
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Init_ProcList( Agrif_Mygrid % proc_def_list, Agrif_Nbprocs )
+        call Agrif_pl_copy( Agrif_Mygrid % proc_def_list, Agrif_Mygrid % required_proc_list )
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_Init
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_MPI_switch_comm ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: comm    !< MPI communicator you want to switch to.
+!
+    include 'mpif.h'
+    integer :: code
+    logical :: mpi_was_called
+!
+    call MPI_INITIALIZED( mpi_was_called, code )
+    if ( .not. mpi_was_called ) return
+!
+    call MPI_COMM_SIZE(comm, Agrif_Nbprocs, code)
+    call MPI_COMM_RANK(comm, Agrif_ProcRank, code)
+    Agrif_mpi_comm = comm
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_switch_comm
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_MPI_get_grid_comm ( ) result ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer :: comm
+    comm = Agrif_Curgrid % communicator
+!---------------------------------------------------------------------------------------------------
+end function Agrif_MPI_get_grid_comm
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_MPI_set_grid_comm ( comm )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: comm
+    Agrif_Curgrid % communicator = comm
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_MPI_set_grid_comm
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_Init_ProcList ( proclist, nbprocs )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(inout) :: proclist
+    integer,               intent(in)    :: nbprocs
+!
+    include 'mpif.h'
+    type(Agrif_Proc), pointer     :: new_proc
+    integer                       :: p, ierr
+    integer                       :: imin, imax, jmin, jmax
+    integer, dimension(5)         :: local_proc_grid_info
+    integer, dimension(5,nbprocs) :: all_procs_grid_info
+!
+    call Agrif_get_proc_info(imin, imax, jmin, jmax)
+!
+    local_proc_grid_info(:) = (/Agrif_Procrank, imin, jmin, imax, jmax/)
+!
+    call MPI_ALLGATHER(local_proc_grid_info, 5, MPI_INTEGER, &
+                       all_procs_grid_info,  5, MPI_INTEGER, Agrif_mpi_comm, ierr)
+!
+    do p = 1,nbprocs
+!
+        allocate(new_proc)
+        new_proc % pn = all_procs_grid_info(1,p)
+        new_proc % imin(1) = all_procs_grid_info(2,p)
+        new_proc % imin(2) = all_procs_grid_info(3,p)
+        new_proc % imax(1) = all_procs_grid_info(4,p)
+        new_proc % imax(2) = all_procs_grid_info(5,p)
+        call Agrif_pl_append( proclist, new_proc )
+!
+    enddo
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_ProcList
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Get_External_Data_first
+!---------------------------------------------------------------------------------------------------
+subroutine Get_External_Data_first ( pttruetab, cetruetab, pttruetabwhole, cetruetabwhole,  &
+                                     nbdim, memberoutall, coords, sendtoproc, recvfromproc, &
+                                     imin, imax, imin_recv, imax_recv )
+!---------------------------------------------------------------------------------------------------
+    include 'mpif.h'
+!
+    integer,                                     intent(in)  :: nbdim
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetab,     cetruetab
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in)  :: pttruetabwhole,cetruetabwhole
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(in)  :: memberoutall
+    integer, dimension(nbdim),                   intent(in)  :: coords
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: sendtoproc
+    logical, dimension(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin,imax
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin_recv,imax_recv
+!
+    integer :: imintmp, imaxtmp, i, j, k, i1
+    integer :: imin1,imax1
+    logical :: tochange,tochangebis
+    integer, dimension(nbdim,0:Agrif_NbProcs-1)    :: pttruetab2,cetruetab2
+!
+! pttruetab2 and cetruetab2 are modified arrays in order to always
+! send the most inner points
+!
+    pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
+    cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+!
+    do k = 0,Agrif_Nbprocs-1
+    do i = 1,nbdim
+        tochangebis = .TRUE.
+        DO i1 = 1,nbdim
+            IF (i /= i1) THEN
+                IF ( (pttruetab(i1,Agrif_Procrank) /= pttruetab(i1,k))  .OR. &
+                     (cetruetab(i1,Agrif_Procrank) /= cetruetab(i1,k))) THEN
+                    tochangebis = .FALSE.
+                    EXIT
+                ENDIF
+            ENDIF
+        ENDDO
+        IF (tochangebis) THEN
+            imin1 = max(pttruetab(i,Agrif_Procrank), pttruetab(i,k))
+            imax1 = min(cetruetab(i,Agrif_Procrank), cetruetab(i,k))
+! Always send the most interior points
+
+            tochange = .false.
+            IF (cetruetab(i,Agrif_Procrank) > cetruetab(i,k)) THEN
+                DO j=imin1,imax1
+                    IF ((cetruetab(i,k)-j) > (j-pttruetab(i,Agrif_Procrank))) THEN
+                        imintmp = j+1
+                        tochange = .TRUE.
+                    ELSE
+                        EXIT
+                    ENDIF
+                ENDDO
+            ENDIF
+
+            if (tochange) then
+                pttruetab2(i,Agrif_Procrank) = imintmp
+            endif
+
+            tochange = .FALSE.
+            imaxtmp=0
+            IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k)) THEN
+                DO j=imax1,imin1,-1
+                    IF ((j-pttruetab(i,k)) > (cetruetab(i,Agrif_Procrank)-j)) THEN
+                        imaxtmp = j-1
+                        tochange = .TRUE.
+                    ELSE
+                        EXIT
+                    ENDIF
+                ENDDO
+            ENDIF
+
+            if (tochange) then
+                cetruetab2(i,Agrif_Procrank) = imaxtmp
+            endif
+        ENDIF
+    enddo
+    enddo
+
+    do k = 0,Agrif_NbProcs-1
+!
+        sendtoproc(k) = .true.
+!
+!CDIR SHORTLOOP
+        do i = 1,nbdim
+            imin(i,k) = max(pttruetab2(i,Agrif_Procrank), pttruetabwhole(i,k))
+            imax(i,k) = min(cetruetab2(i,Agrif_Procrank), cetruetabwhole(i,k))
+!
+            if ( (imin(i,k) > imax(i,k)) .and. (coords(i) /= 0) ) then
+                sendtoproc(k) = .false.
+            endif
+        enddo
+        IF ( .not. memberoutall(k) ) THEN
+            sendtoproc(k) = .false.
+        ENDIF
+    enddo
+!
+    call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,recvfromproc,imin_recv,imax_recv)
+!---------------------------------------------------------------------------------------------------
+end subroutine Get_External_Data_first
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ExchangeSameLevel_first
+!---------------------------------------------------------------------------------------------------
+subroutine ExchangeSameLevel_first ( sendtoproc, nbdim, imin, imax, recvfromproc, &
+                                     imin_recv, imax_recv )
+!---------------------------------------------------------------------------------------------------
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)  :: sendtoproc
+    INTEGER,                                     intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imin
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)  :: imax
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(out) :: recvfromproc
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imin_recv
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imax_recv
+!
+    include 'mpif.h'
+    INTEGER :: k
+    INTEGER :: etiquette = 100
+    INTEGER :: code
+    LOGICAL :: res
+    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
+    INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1)    :: iminmax_temp
+
+    do k = 0,Agrif_ProcRank-1
+!
+        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
+!
+        if (sendtoproc(k)) then
+            iminmax_temp(:,1,k) = imin(:,k)
+            iminmax_temp(:,2,k) = imax(:,k)
+            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette,Agrif_mpi_comm,code)
+        endif
+!
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
+        recvfromproc(k) = res
+!
+        if (recvfromproc(k)) then
+            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,statut,code)
+            imin_recv(:,k) = iminmax_temp(:,1,k)
+            imax_recv(:,k) = iminmax_temp(:,2,k)
+        endif
+!
+    enddo
+
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code)
+!
+        if (sendtoproc(k)) then
+!
+            iminmax_temp(:,1,k) = imin(:,k)
+            iminmax_temp(:,2,k) = imax(:,k)
+
+            call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,code)
+        endif
+!
+    enddo
+!
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank-1,0,-1
+!
+        call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code)
+        recvfromproc(k) = res
+!
+        if (recvfromproc(k)) then
+!
+            call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, &
+                    Agrif_mpi_comm,statut,code)
+
+            imin_recv(:,k) = iminmax_temp(:,1,k)
+            imax_recv(:,k) = iminmax_temp(:,2,k)
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine ExchangeSamelevel_first
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine ExchangeSameLevel
+!---------------------------------------------------------------------------------------------------
+subroutine ExchangeSameLevel ( sendtoproc, recvfromproc, nbdim,    &
+                               pttruetabwhole, cetruetabwhole,     &
+                               imin, imax, imin_recv, imax_recv,   &
+                               memberout, tempC, tempCextend )
+!---------------------------------------------------------------------------------------------------
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: sendtoproc
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),       intent(in)    :: recvfromproc
+    INTEGER,                                     intent(in)    :: nbdim
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: pttruetabwhole
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: cetruetabwhole
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin,      imax
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in)    :: imin_recv, imax_recv
+    LOGICAL,                                     intent(in)    :: memberout
+    TYPE(Agrif_Variable), pointer,               intent(inout) :: tempC, tempCextend
+!
+    include 'mpif.h'
+    INTEGER :: i,k
+    INTEGER :: etiquette = 100
+    INTEGER :: code, datasize
+    INTEGER, DIMENSION(MPI_STATUS_SIZE)   :: statut
+    TYPE(Agrif_Variable), pointer, SAVE   :: temprecv
+!
+    IF (memberout) THEN
+        call Agrif_array_allocate(tempCextend, pttruetabwhole(:,Agrif_ProcRank),  &
+                                               cetruetabwhole(:,Agrif_ProcRank),nbdim)
+        call Agrif_var_set_array_tozero(tempCextend,nbdim)
+    ENDIF
+!
+    IF (sendtoproc(Agrif_ProcRank)) THEN
+        call Agrif_var_copy_array(tempCextend,imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
+                                  tempC,      imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &
+                                  nbdim)
+    ENDIF
+!
+    do k = 0,Agrif_ProcRank-1
+!
+        if (sendtoproc(k)) then
+!
+            datasize = 1
+!
+!CDIR SHORTLOOP
+            do i = 1,nbdim
+                datasize = datasize * (imax(i,k)-imin(i,k)+1)
+            enddo
+!
+            SELECT CASE(nbdim)
+            CASE(1)
+                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(2)
+                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(3)
+                call Agrif_Send_3Darray(tempC%array3,lbound(tempC%array3),imin(:,k),imax(:,k),k)
+            CASE(4)
+                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(5)
+                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k),     &
+                                           imin(5,k):imax(5,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(6)
+                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
+                                           imin(2,k):imax(2,k),     &
+                                           imin(3,k):imax(3,k),     &
+                                           imin(4,k):imax(4,k),     &
+                                           imin(5,k):imax(5,k),     &
+                                           imin(6,k):imax(6,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            END SELECT
+!
+        endif
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        if (recvfromproc(k)) then
+!
+            datasize = 1
+!
+!CDIR SHORTLOOP
+            do i = 1,nbdim
+                datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1)
+            enddo
+
+            if (.not.associated(temprecv)) allocate(temprecv)
+            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
+
+            SELECT CASE(nbdim)
+            CASE(1)
+                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(2)
+                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(3)
+                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(4)
+                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(5)
+                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            CASE(6)
+                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette, &
+                        Agrif_mpi_comm,statut,code)
+            END SELECT
+
+            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+            call Agrif_array_deallocate(temprecv,nbdim)
+!
+        endif
+    enddo
+
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank+1,Agrif_Nbprocs-1
+!
+        if (sendtoproc(k)) then
+!
+            SELECT CASE(nbdim)
+            CASE(1)
+                datasize=SIZE(tempC%array1(imin(1,k):imax(1,k)))
+                call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(2)
+                datasize=SIZE(tempC%array2(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k)))
+                call MPI_SEND(tempC%array2(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(3)
+                datasize=SIZE(tempC%array3(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k)))
+                call MPI_SEND(tempC%array3(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(4)
+                datasize=SIZE(tempC%array4(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k)))
+                call MPI_SEND(tempC%array4(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(5)
+                datasize=SIZE(tempC%array5(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k)))
+                call MPI_SEND(tempC%array5(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            CASE(6)
+                datasize=SIZE(tempC%array6(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k),     &
+                                               imin(6,k):imax(6,k)))
+                call MPI_SEND(tempC%array6(imin(1,k):imax(1,k),     &
+                                               imin(2,k):imax(2,k),     &
+                                               imin(3,k):imax(3,k),     &
+                                               imin(4,k):imax(4,k),     &
+                                               imin(5,k):imax(5,k),     &
+                                               imin(6,k):imax(6,k)),    &
+                        datasize,Agrif_MPI_prec,k,etiquette,      &
+                        Agrif_mpi_comm,code)
+            END SELECT
+!
+        endif
+!
+    enddo
+!
+!   Reception from others processors of the necessary part of the parent grid
+    do k = Agrif_ProcRank-1,0,-1
+!
+        if (recvfromproc(k)) then
+!
+            if (.not.associated(temprecv)) allocate(temprecv)
+            call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim)
+
+            SELECT CASE(nbdim)
+            CASE(1)
+                datasize=SIZE(temprecv%array1)
+                call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(2)
+                datasize=SIZE(temprecv%array2)
+                call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(3)
+                datasize=SIZE(temprecv%array3)
+                call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            CASE(4)
+                datasize=SIZE(temprecv%array4)
+                call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette,&
+                          Agrif_mpi_comm,statut,code)
+            CASE(5)
+                datasize=SIZE(temprecv%array5)
+                call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette,&
+                         Agrif_mpi_comm,statut,code)
+            CASE(6)
+                datasize=SIZE(temprecv%array6)
+                call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette,&
+                        Agrif_mpi_comm,statut,code)
+            END SELECT
+
+            call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim)
+            call Agrif_array_deallocate(temprecv,nbdim)
+!
+        endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine ExchangeSamelevel
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Send_3Darray
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Send_3Darray ( tab3D, bounds, imin, imax, k )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),                                     intent(in) :: bounds
+    real, dimension(bounds(1):,bounds(2):,bounds(3):), target, intent(in) :: tab3D
+    integer, dimension(3),                                     intent(in) :: imin, imax
+    integer,                                                   intent(in) :: k
+!
+    integer :: etiquette = 100
+    integer :: datasize, code
+    include 'mpif.h'
+
+    datasize = SIZE(tab3D(imin(1):imax(1),  &
+                          imin(2):imax(2),  &
+                          imin(3):imax(3)))
+
+    call MPI_SEND( tab3D( imin(1):imax(1),  &
+                          imin(2):imax(2),  &
+                          imin(3):imax(3)), &
+                          datasize,Agrif_MPI_prec,k,etiquette,Agrif_mpi_comm,code)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Send_3Darray
+!===================================================================================================
+!
+#else
+    subroutine dummy_Agrif_Mpp ()
+    end subroutine dummy_Agrif_Mpp
+#endif
+!
+end Module Agrif_Mpp
Index: vendors/AGRIF/AGRIF_FILES/modprocs.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modprocs.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modprocs.F90	(revision 9621)
@@ -0,0 +1,208 @@
+module Agrif_Procs
+!
+    implicit none
+!
+    type Agrif_Proc
+        integer               :: pn       !< Proc index in coarse grid
+        integer               :: pi       !< Proc index in x-direction (informative only, could be removed)
+        integer               :: pj       !< Proc index in y-direction (informative only, could be removed)
+        integer, dimension(3) :: imin
+        integer, dimension(3) :: imax
+        integer               :: nb_seqs = 0  !< Number of integration sequences the proc is attached to.
+        integer               :: grid_id = 0  !< Grid id the proc is attached to.
+    end type Agrif_Proc
+!
+    type Agrif_Proc_p
+        type(Agrif_Proc),   pointer   :: proc => NULL()  !< Pointer to the actual proc structure
+        type(Agrif_Proc_p), pointer   :: next => NULL()  !< Next proc in the list
+    end type Agrif_Proc_p
+!
+    type Agrif_Proc_List
+        integer                       :: nitems = 0      !< Number of elements in the list
+        type(Agrif_Proc_p), pointer   :: first => NULL() !< First proc in the list
+        type(Agrif_Proc_p), pointer   :: last  => NULL() !< Last proc inserted in the list
+    end type Agrif_Proc_List
+!
+contains
+!
+!===================================================================================================
+subroutine Agrif_pl_append ( proclist, proc )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List),     intent(inout)  :: proclist
+    type(Agrif_Proc), pointer, intent(in)     :: proc
+!
+    type(Agrif_Proc_p), pointer   :: new_pp
+!
+    allocate( new_pp )
+!
+    new_pp % proc => proc
+    new_pp % next => NULL()
+!
+    if ( associated(proclist % last) ) then
+        ! the list is not empty, let 'proc' be the next after the last (ie. the last one).
+        proclist % last % next => new_pp
+    else
+        ! the list has just been initialized. Let 'proc' be the first one.
+        proclist % first => new_pp
+    endif
+    ! anyway, for next time 'proc' will be the last one. 
+    proclist % last => new_pp
+    proclist % nitems = proclist % nitems + 1
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_append
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_print_array ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in) :: proclist
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: proc
+!
+    pp => proclist % first
+!
+    write(*,'("/-------+-----+-----+------+------+------+------+------\")')
+    write(*,'("| iproc | ipx | ipy | imin | imax | jmin | jmax | grid |")')
+    write(*,'("|-------+-----+-----+------+------+------+------+------|")')
+    do while ( associated(pp) )
+        proc => pp % proc
+        write(*,'("|",i6," |",i4," |",i4," |",i5," :",i5," |",i5," :",i5," | ",i4," |")') &
+            proc % pn, proc % pi, proc % pj, proc % imin(1), proc % imax(1), proc % imin(2), proc % imax(2), &
+            proc % grid_id
+        pp => pp % next
+    enddo
+    write(*,'("\-------+-----+-----+------+------+------+------+------/")')
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_print_array
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_print ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in) :: proclist
+!
+    type(Agrif_Proc_p), pointer :: pp
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        write(*,'(i0,",")',advance='no') pp % proc % pn
+        pp => pp % next
+    enddo
+    write(*,*)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_print
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_copy ( proclist, copy )
+!
+!< Carries out a copy of 'proclist' into 'copy'
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)    :: proclist
+    type(Agrif_Proc_List), intent(out)   :: copy
+!
+    type(Agrif_Proc_p),    pointer    :: pp
+!
+    call Agrif_pl_clear(copy)
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        call Agrif_pl_append( copy, pp % proc )
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_copy
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_deep_copy ( proclist, copy )
+!
+!< Carries out a deep copy of 'proclist' into 'copy'
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)    :: proclist
+    type(Agrif_Proc_List), intent(out)   :: copy
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: new_proc
+!
+    call Agrif_pl_clear(copy)
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        allocate( new_proc )
+        new_proc = pp % proc
+        call Agrif_pl_append( copy, new_proc )
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_deep_copy
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_clear ( proclist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(inout)  :: proclist
+!
+    type(Agrif_Proc_p), pointer    :: pp, ppd
+!
+    pp => proclist % first
+!    
+    do while( associated(pp) )
+        ppd => pp
+        pp  => pp % next
+        deallocate(ppd)
+    enddo
+    
+    proclist % first => NULL()
+    proclist % last  => NULL()
+    proclist % nitems = 0
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_clear
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_pl_to_array ( proclist, procarray )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List),                       intent(in)   :: proclist
+    type(Agrif_Proc), dimension(:), allocatable, intent(out)  :: procarray
+!
+    type(Agrif_Proc_p), pointer   :: pp
+!
+    allocate( procarray(1:proclist % nitems) )
+!
+    pp => proclist % first
+    do while ( associated(pp) )
+        procarray(pp%proc%pn+1) = pp % proc
+        pp => pp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_pl_to_array
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_pl_search_proc ( proclist, rank ) result ( proc )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Proc_List), intent(in)   :: proclist
+    integer,               intent(in)   :: rank
+!
+    type(Agrif_Proc_p), pointer :: pp
+    type(Agrif_Proc),   pointer :: proc
+    logical :: found
+!
+    found = .false.
+    proc => NULL()
+    pp => proclist % first
+    do while ( .not.found .and. associated(pp) )
+        if ( pp % proc % pn == rank ) then
+            proc => pp % proc
+            return
+        else
+            pp => pp % next
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_pl_search_proc
+!===================================================================================================
+!
+end module Agrif_Procs
Index: vendors/AGRIF/AGRIF_FILES/modsauv.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modsauv.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modsauv.F90	(revision 9621)
@@ -0,0 +1,663 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!> Module Agrif_Save
+!!
+!! Module for the initialization by copy of the grids created by clustering.
+!
+module Agrif_Save
+!
+    use Agrif_Types
+    use Agrif_Link
+    use Agrif_Arrays
+    use Agrif_Variables
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+! subroutine Agrif_deallocate_Arrays
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays ( var )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer :: var
+!
+    if (allocated(var%array1))  deallocate(var%array1)
+    if (allocated(var%array2))  deallocate(var%array2)
+    if (allocated(var%array3))  deallocate(var%array3)
+    if (allocated(var%array4))  deallocate(var%array4)
+    if (allocated(var%array5))  deallocate(var%array5)
+    if (allocated(var%array6))  deallocate(var%array6)
+!
+    if (allocated(var%darray1)) deallocate(var%darray1)
+    if (allocated(var%darray2)) deallocate(var%darray2)
+    if (allocated(var%darray3)) deallocate(var%darray3)
+    if (allocated(var%darray4)) deallocate(var%darray4)
+    if (allocated(var%darray5)) deallocate(var%darray5)
+    if (allocated(var%darray6)) deallocate(var%darray6)
+!
+    if (allocated(var%sarray1)) deallocate(var%sarray1)
+    if (allocated(var%sarray2)) deallocate(var%sarray2)
+    if (allocated(var%sarray3)) deallocate(var%sarray3)
+    if (allocated(var%sarray4)) deallocate(var%sarray4)
+    if (allocated(var%sarray5)) deallocate(var%sarray5)
+    if (allocated(var%sarray6)) deallocate(var%sarray6)
+!
+!
+    if (associated(var%oldvalues2D))    deallocate(var%oldvalues2D)
+    if (allocated(var%posvar))          deallocate(var%posvar)
+    if (allocated(var%interptab))       deallocate(var%interptab)
+    if (allocated(var%coords))          deallocate(var%coords)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_c ( var_c )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_c), pointer :: var_c
+!
+    if (allocated(var_c%carray1)) deallocate(var_c%carray1)
+    if (allocated(var_C%carray2)) deallocate(var_c%carray2)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_c
+!===================================================================================================
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_l ( var_l )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_l), pointer :: var_l
+!
+!
+    if (allocated(var_l%larray1)) deallocate(var_l%larray1)
+    if (allocated(var_l%larray2)) deallocate(var_l%larray2)
+    if (allocated(var_l%larray3)) deallocate(var_l%larray3)
+    if (allocated(var_l%larray4)) deallocate(var_l%larray4)
+    if (allocated(var_l%larray5)) deallocate(var_l%larray5)
+    if (allocated(var_l%larray6)) deallocate(var_l%larray6)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_l
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_deallocate_Arrays_i ( var_i )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable_i), pointer :: var_i
+!
+!
+    if (allocated(var_i%iarray1)) deallocate(var_i%iarray1)
+    if (allocated(var_i%iarray2)) deallocate(var_i%iarray2)
+    if (allocated(var_i%iarray3)) deallocate(var_i%iarray3)
+    if (allocated(var_i%iarray4)) deallocate(var_i%iarray4)
+    if (allocated(var_i%iarray5)) deallocate(var_i%iarray5)
+    if (allocated(var_i%iarray6)) deallocate(var_i%iarray6)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_deallocate_Arrays_i
+!
+!===================================================================================================
+!  subroutine Agrif_Free_data_before
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_data_before ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr ! Pointer on the current grid
+!
+    integer :: i
+    type(Agrif_Variables_List), pointer :: parcours
+    type(Agrif_Variable),       pointer :: var
+    type(Agrif_Variable_c),     pointer :: var_c
+    type(Agrif_Variable_r),     pointer :: var_r
+    type(Agrif_Variable_l),     pointer :: var_l
+    type(Agrif_Variable_i),     pointer :: var_i
+!
+    do i = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Gr % tabvars(i)
+!
+        if ( .NOT. Agrif_Mygrid % tabvars(i) % restore ) then
+            call Agrif_deallocate_Arrays(var)
+        endif
+!
+        if (associated(var%list_interp)) then
+            call Agrif_Free_list_interp(var%list_interp)
+        endif
+!
+    enddo
+    do i=1,Agrif_NbVariables(1)
+        var_c => Agrif_Gr % tabvars_c(i)
+        call Agrif_deallocate_Arrays_c(var_c)
+    enddo
+    do i=1,Agrif_NbVariables(3)
+        var_l => Agrif_Gr % tabvars_l(i)
+        call Agrif_deallocate_Arrays_l(var_l)
+    enddo
+    do i=1,Agrif_NbVariables(4)
+        var_i => Agrif_Gr % tabvars_i(i)
+        call Agrif_deallocate_Arrays_i(var_i)
+    enddo
+
+    parcours => Agrif_Gr % variables
+
+    do i = 1,Agrif_Gr%NbVariables
+!
+        if ( .NOT. parcours%var%root_var % restore ) then
+            call Agrif_deallocate_Arrays(parcours%var)
+        endif
+!
+        if (associated(parcours%var%list_interp)) then
+            call Agrif_Free_list_interp(parcours%var%list_interp)
+        endif
+!
+        if ( .NOT. parcours%var%root_var % restore ) then
+            deallocate(parcours%var)
+        endif
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+        if ( Agrif_Probdim == 1 ) deallocate(Agrif_Gr%tabpoint1D)
+        if ( Agrif_Probdim == 2 ) deallocate(Agrif_Gr%tabpoint2D)
+        if ( Agrif_Probdim == 3 ) deallocate(Agrif_Gr%tabpoint3D)
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_data_before
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_list_interp
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_list_interp ( list_interp )
+!---------------------------------------------------------------------------------------------------
+      type(Agrif_List_Interp_Loc), pointer :: list_interp
+!
+      if (associated(list_interp%suiv)) call Agrif_Free_list_interp(list_interp%suiv)
+
+#if defined AGRIF_MPI
+       deallocate(list_interp%interp_loc%tab4t)
+       deallocate(list_interp%interp_loc%memberinall)
+       deallocate(list_interp%interp_loc%sendtoproc1)
+       deallocate(list_interp%interp_loc%recvfromproc1)
+#endif
+       deallocate(list_interp%interp_loc)
+       deallocate(list_interp)
+       nullify(list_interp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_list_interp
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_data_after
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Free_data_after ( Agrif_Gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: Agrif_Gr  !< Pointer on the current grid
+!
+    integer :: i
+    type(Agrif_Variables_List), pointer :: parcours, rootparcours
+    type(Agrif_Variable),       pointer :: var
+!
+    do i = 1,Agrif_NbVariables(0)
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+            var => Agrif_Gr%tabvars(i)
+            call Agrif_deallocate_Arrays(var)
+        endif
+    enddo
+!
+    parcours => Agrif_Gr%variables
+    rootparcours => Agrif_Mygrid%variables
+!
+    do i = 1,Agrif_Gr%NbVariables
+        if (rootparcours%var % restore ) then
+            call Agrif_deallocate_Arrays(parcours%var)
+            deallocate(parcours%var)
+        endif
+        parcours => parcours % next
+        rootparcours => rootparcours % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_data_after
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld_All
+!
+!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_CopyFromOld_All ( g, oldchildlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: g   !< Pointer on the current grid
+    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    real    :: g_eps, eps, oldgrid_eps
+    integer :: out
+    integer :: iii
+!
+    out = 0
+!
+    parcours => oldchildlist % first
+!
+    do while (associated(parcours))
+!
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+!
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1,Agrif_Probdim
+                g_eps = min(g_eps,g % Agrif_dx(iii))
+                oldgrid_eps = min(oldgrid_eps, parcours % gr % Agrif_dx(iii))
+            enddo
+!
+            eps = min(g_eps,oldgrid_eps)/100.
+!
+            do iii = 1,Agrif_Probdim
+                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
+                    parcours => parcours % next
+                    out = 1
+                    exit
+                endif
+            enddo
+!
+            if ( out == 1 ) cycle
+!
+            call Agrif_CopyFromOld(g,parcours%gr)
+!
+        endif
+!
+        call Agrif_CopyFromOld_All(g,parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+      enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld
+!
+!> Call to the Agrif_Copy procedure.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopyFromOld ( new_gr, old_gr )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: new_gr  !< Pointer on the current grid
+    type(Agrif_Grid), pointer, intent(inout) :: old_gr  !< Pointer on an old grid
+!
+    type(Agrif_Variable), pointer   :: new_var
+    type(Agrif_Variable), pointer   :: old_var
+    integer :: i
+!
+    do i = 1,Agrif_NbVariables(0)
+        if ( Agrif_Mygrid % tabvars(i) % restore ) then
+            old_var => old_gr % tabvars(i)
+            new_var => new_gr % tabvars(i)
+            call Agrif_Copy(new_gr, old_gr, new_var, old_var )
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOld_AllOneVar
+!
+!> Called in Agrif_Clustering#Agrif_Init_Hierarchy.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_CopyFromOld_AllOneVar ( g, oldchildlist, indic )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: g            !< Pointer on the current grid
+    type(Agrif_Grid_List),     intent(in)    :: oldchildlist
+    integer,                   intent(in)    :: indic
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    real    :: g_eps,eps,oldgrid_eps
+    integer :: out
+    integer :: iii
+!
+    out = 0
+!
+    parcours => oldchildlist % first
+!
+    do while (associated(parcours))
+!
+        if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then
+!
+            g_eps = huge(1.)
+            oldgrid_eps = huge(1.)
+            do iii = 1,Agrif_Probdim
+                g_eps = min(g_eps,g % Agrif_dx(iii))
+                oldgrid_eps = min(oldgrid_eps,parcours % gr % Agrif_dx(iii))
+            enddo
+!
+            eps = min(g_eps,oldgrid_eps)/100.
+!
+            do iii = 1,Agrif_Probdim
+                if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then
+                    parcours => parcours % next
+                    out = 1
+                    exit
+                endif
+            enddo
+
+            if ( out == 1 ) cycle
+!
+            call Agrif_CopyFromOldOneVar(g,parcours%gr,indic)
+!
+        endif
+!
+        call Agrif_CopyFromOld_AllOneVar(g,parcours%gr % child_list,indic)
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOld_AllOneVar
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopyFromOldOneVar
+!
+!> Call to Agrif_Copy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopyFromOldOneVar ( new_gr, old_gr, indic )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(inout) :: new_gr     !< Pointer on the current grid
+    type(Agrif_Grid), pointer, intent(in)    :: old_gr     !< Pointer on an old grid
+    integer,                   intent(in)    :: indic
+!
+    type(Agrif_Variable),  pointer  :: new_var, old_var
+!
+    new_var => Agrif_Search_Variable(new_gr, -indic)
+    old_var => Agrif_Search_Variable(old_gr, -indic)
+!
+    call Agrif_array_allocate(new_var,new_var%lb,new_var%ub,new_var%nbdim)
+    call Agrif_Copy(new_gr, old_gr, new_var,old_var)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopyFromOldOneVar
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Copy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Copy ( new_gr, old_gr, new_var, old_var )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),     pointer, intent(in)       :: new_gr !< Pointer on the current grid
+    type(Agrif_Grid),     pointer, intent(in)       :: old_gr !< Pointer on an old grid
+    type(Agrif_Variable), pointer, intent(inout)    :: new_var
+    type(Agrif_Variable), pointer, intent(in)       :: old_var
+!
+    type(Agrif_Variable), pointer :: root ! Pointer on the variable of the root grid
+    integer               :: nbdim     ! Number of dimensions of the current grid
+    integer, dimension(6) :: pttabnew  ! Indexes of the first point in the domain
+    integer, dimension(6) :: petabnew  ! Indexes of the first point in the domain
+    integer, dimension(6) :: pttabold  ! Indexes of the first point in the domain
+    integer, dimension(6) :: petabold  ! Indexes of the first point in the domain
+    integer, dimension(6) :: nbtabold  ! Number of cells in each direction
+    integer, dimension(6) :: nbtabnew  ! Number of cells in each direction
+    real,    dimension(6) :: snew,sold
+    real,    dimension(6) :: dsnew,dsold
+    real    :: eps
+    integer :: n
+!
+    root => new_var % root_var
+    nbdim = root % nbdim
+!
+    do n = 1,nbdim
+!
+        select case(root % interptab(n))
+!
+        case('x')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n)  = new_gr % Agrif_x(1)
+            sold(n)  = old_gr % Agrif_x(1)
+            dsnew(n) = new_gr % Agrif_dx(1)
+            dsold(n) = old_gr % Agrif_dx(1)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(1)
+                petabold(n) = pttabold(n) + old_gr % nb(1)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(1) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(1) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('y')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n) = new_gr % Agrif_x(2)
+            sold(n) = old_gr % Agrif_x(2)
+            dsnew(n) = new_gr % Agrif_dx(2)
+            dsold(n) = old_gr % Agrif_dx(2)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(2)
+                petabold(n) = pttabold(n) + old_gr % nb(2)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(2) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(2) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('z')
+!
+            pttabnew(n) = root % point(n)
+            pttabold(n) = root % point(n)
+            snew(n)  = new_gr % Agrif_x(3)
+            sold(n)  = old_gr % Agrif_x(3)
+            dsnew(n) = new_gr % Agrif_dx(3)
+            dsold(n) = old_gr % Agrif_dx(3)
+!
+            if (root % posvar(n) == 1) then
+                petabnew(n) = pttabnew(n) + new_gr % nb(3)
+                petabold(n) = pttabold(n) + old_gr % nb(3)
+            else
+                petabnew(n) = pttabnew(n) + new_gr % nb(3) - 1
+                petabold(n) = pttabold(n) + old_gr % nb(3) - 1
+                snew(n) = snew(n) + dsnew(n)/2.
+                sold(n) = sold(n) + dsold(n)/2.
+            endif
+!
+        case('N')
+!
+            call Agrif_get_var_bounds(new_var,pttabnew(n),petabnew(n),n)
+!
+            pttabold(n) = pttabnew(n)
+            petabold(n) = petabnew(n)
+            snew(n) = 0.
+            sold(n) = 0.
+            dsnew(n) = 1.
+            dsold(n) = 1.
+!
+        end select
+!
+    enddo
+!
+    do n = 1,nbdim
+        nbtabnew(n) = petabnew(n) - pttabnew(n)
+        nbtabold(n) = petabold(n) - pttabold(n)
+    enddo
+!
+    eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim))) / 100.
+!
+    do n = 1,nbdim
+        if (snew(n) > (sold(n)+dsold(n)*nbtabold(n)+eps)) return
+        if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) < sold(n)) return
+    enddo
+!
+    call Agrif_CopynD(new_var,old_var,pttabold,petabold,pttabnew,petabnew,  &
+                      sold,snew,dsold,dsnew,nbdim)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Copy
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_CopynD
+!
+!> Copy from the nD variable Old_Var the nD variable New_Var
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_CopynD ( new_var, old_var, pttabold, petabold, pttabnew, petabnew, &
+                          sold, snew, dsold, dsnew, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), pointer, intent(inout) :: new_var
+    type(Agrif_Variable), pointer, intent(in)    :: old_var
+    integer, dimension(nbdim),     intent(in)    :: pttabnew
+    integer, dimension(nbdim),     intent(in)    :: petabnew
+    integer, dimension(nbdim),     intent(in)    :: pttabold
+    integer, dimension(nbdim),     intent(in)    :: petabold
+    real,    dimension(nbdim),     intent(in)    :: snew, sold
+    real,    dimension(nbdim),     intent(in)    :: dsnew,dsold
+    integer,                       intent(in)    :: nbdim
+!
+    integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
+!
+    real,    dimension(nbdim) :: dim_gmin,   dim_gmax
+    real,    dimension(nbdim) :: dim_newmin, dim_newmax
+    real,    dimension(nbdim) :: dim_min
+    integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax
+!
+    do i = 1,nbdim
+!
+        dim_gmin(i) = sold(i)
+        dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i)
+!
+        dim_newmin(i) = snew(i)
+        dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i)
+!
+    enddo
+!
+    do i = 1,nbdim
+        if (dim_gmax(i) < dim_newmin(i)) return
+        if (dim_gmin(i) > dim_newmax(i)) return
+    enddo
+!
+    do i = 1,nbdim
+!
+        ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),dim_newmin(i))-dim_newmin(i))/dsnew(i))
+        dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i)
+        ind_gmin(i)   = pttabold(i) + nint((dim_min(i)-dim_gmin(i))/dsold(i))
+        ind_newmax(i) = pttabnew(i) + int((min(dim_gmax(i),dim_newmax(i))-dim_newmin(i))/dsnew(i))
+!
+    enddo
+!
+    select case (nbdim)
+!
+    case (1)
+        i0 = ind_gmin(1)
+        do i = ind_newmin(1),ind_newmax(1)
+            new_var % array1(i)    = old_var % array1(i0)
+            new_var % restore1D(i) = 1
+            i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (2)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+            new_var % array2(i,j)    = old_var % array2(i0,j0)
+            new_var % restore2D(i,j) = 1
+            j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (3)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+            new_var % array3(i,j,k)    =  old_var % array3(i0,j0,k0)
+            new_var % restore3D(i,j,k) = 1
+            k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (4)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+            new_var % array4(i,j,k,l)    = old_var % array4(i0,j0,k0,l0)
+            new_var % restore4D(i,j,k,l) = 1
+            l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (5)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
+            new_var % array5(i,j,k,l,m)    = old_var % array5(i0,j0,k0,l0,m0)
+            new_var % restore5D(i,j,k,l,m) = 1
+            m0 = m0 + int(dsnew(5)/dsold(5))
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+    case (6)
+        i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1)
+        j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2)
+        k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3)
+        l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4)
+        m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5)
+        n0 = ind_gmin(6) ; do n = ind_newmin(6),ind_newmax(6)
+            new_var % array6(i,j,k,l,m,n)    = old_var % array6(i0,j0,k0,l0,m0,n0)
+            new_var % restore6D(i,j,k,l,m,n) = 1
+            n0 = n0 + int(dsnew(6)/dsold(6))
+        enddo
+        m0 = m0 + int(dsnew(5)/dsold(5))
+        enddo
+        l0 = l0 + int(dsnew(4)/dsold(4))
+        enddo
+        k0 = k0 + int(dsnew(3)/dsold(3))
+        enddo
+        j0 = j0 + int(dsnew(2)/dsold(2))
+        enddo
+        i0 = i0 + int(dsnew(1)/dsold(1))
+        enddo
+!
+      end select
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_CopynD
+!===================================================================================================
+!
+end module Agrif_Save
Index: vendors/AGRIF/AGRIF_FILES/modseq.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modseq.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modseq.F90	(revision 9621)
@@ -0,0 +1,640 @@
+module Agrif_seq
+!
+    use Agrif_Init
+    use Agrif_Procs
+    use Agrif_Arrays
+!
+    implicit none
+!
+contains
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+function Agrif_seq_allocate_list ( nb_seqs ) result( seqlist )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: nb_seqs
+!
+    type(Agrif_Sequence_List), pointer :: seqlist
+!
+    allocate(seqlist)
+    seqlist % nb_seqs = nb_seqs
+    allocate(seqlist % sequences(1:nb_seqs))
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_allocate_list
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_add_grid ( seqlist, seq_num, grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Sequence_List), intent(inout)    :: seqlist
+    integer,                   intent(in)       :: seq_num
+    type(Agrif_Grid), pointer, intent(in)       :: grid
+!
+    call Agrif_gl_append(seqlist % sequences(seq_num) % gridlist, grid )
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_add_grid
+!===================================================================================================
+!
+!===================================================================================================
+recursive subroutine Agrif_seq_init_sequences ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout)  :: grid
+!
+    type(Agrif_PGrid), pointer  :: gp
+!
+#if defined AGRIF_MPI
+!
+! Build list of required procs for each child grid
+    gp => grid % child_list % first
+    do while ( associated( gp ) )
+        call Agrif_seq_build_required_proclist( gp % gr )
+        gp => gp % next
+    enddo
+!
+! Create integration sequences for the current grid
+    call Agrif_seq_create_proc_sequences( grid )
+    call Agrif_seq_allocate_procs_to_childs( grid )
+!
+! Create new communicators for sequences
+    call Agrif_seq_create_communicators( grid )
+!
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_init_sequences
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_build_required_proclist ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: grid
+!
+    type(Agrif_Grid),      pointer  :: parent_grid
+    type(Agrif_Rectangle), pointer  :: grid_rect
+    type(Agrif_Proc_p),    pointer  :: proc_rect
+    type(Agrif_Proc),      pointer  :: proc
+    logical     :: proc_is_required
+    integer     :: i
+!
+    if ( grid % fixedrank == 0 ) then
+!       grid is the Root
+        if ( grid % required_proc_list % nitems == 0 ) then
+            print*, "### Error Agrif_seq_build_required_proclist: empty proc list."
+            print*, "# -> You should check if Agrif_Init_ProcList() is actually working."
+            stop
+        endif
+        return
+    endif
+!
+    parent_grid => grid % parent
+    grid_rect   => grid % rect_in_parent
+    proc_rect   => parent_grid % proc_def_list % first
+!
+
+    do while ( associated( proc_rect ) )
+
+!
+        proc => proc_rect % proc
+!
+        proc_is_required = .true.
+        do i = 1,Agrif_Probdim
+            proc_is_required = ( proc_is_required             .and. &
+                    ( grid_rect % imin(i) <= proc % imax(i) ) .and. &
+                    ( grid_rect % imax(i) >= proc % imin(i) ) )
+        enddo
+!
+        if ( proc_is_required ) then
+            call Agrif_pl_append(grid % required_proc_list, proc)
+        endif
+        proc_rect => proc_rect % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_build_required_proclist
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_create_proc_sequences ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout)    :: grid
+!
+    type(Agrif_Grid_List), pointer :: sorted_child_list
+    type(Agrif_PGrid),     pointer :: child_p
+    type(Agrif_PGrid),     pointer :: g1p, g2p
+    type(Agrif_Proc_p),    pointer :: pp1, pp2
+    type(Agrif_Proc),      pointer :: proc
+    integer                        :: nb_seq_max, nb_seqs, cur_seq
+!
+    nb_seq_max = 0
+!
+    if ( grid % child_list % nitems == 0 ) return
+!
+! For each required proc...
+    pp1  => grid % required_proc_list % first
+    do while ( associated(pp1) )
+        proc => pp1 % proc
+        proc % nb_seqs = 0
+!   ..loop over all child grids...
+        child_p => grid % child_list % first
+        do while ( associated(child_p) )
+!       ..and look for 'proc' in the list of procs required by 'child'
+            pp2 => child_p % gr % required_proc_list % first
+            do while ( associated(pp2) )
+                if ( proc % pn == pp2 % proc % pn ) then
+!                   'proc' is required by this child grid, so we increment its number of sequences
+                    proc % nb_seqs = proc % nb_seqs + 1
+                    pp2 => NULL()
+                else
+                    pp2 => pp2 % next
+                endif
+            enddo
+            child_p => child_p % next
+        enddo
+        nb_seq_max = max(nb_seq_max, proc % nb_seqs)
+        pp1 => pp1 % next
+    enddo
+!
+! For each grid...
+    g1p => grid % child_list % first
+    do while ( associated(g1p) )
+!     compare it with the following ones
+        g2p => g1p % next
+        do while ( associated(g2p) )
+            if ( Agrif_seq_grids_are_connected( g1p % gr, g2p % gr ) ) then
+                call Agrif_gl_append( g1p % gr % neigh_list, g2p % gr )
+                call Agrif_gl_append( g2p % gr % neigh_list, g1p % gr )
+            endif
+            g2p => g2p % next
+        enddo
+        g1p => g1p % next
+    enddo
+!
+! Colorize graph nodes
+    nb_seqs = Agrif_seq_colorize_grid_list(grid % child_list)
+    sorted_child_list => Agrif_gl_merge_sort ( grid % child_list, compare_colors )
+!
+! Create sequence structure
+    cur_seq = 0
+    grid % child_seq => Agrif_seq_allocate_list(nb_seqs)
+    child_p => sorted_child_list % first
+    do while ( associated(child_p) )
+        if ( cur_seq /= child_p % gr % seq_num ) then
+            cur_seq = child_p % gr % seq_num
+        endif
+        call Agrif_seq_add_grid(grid % child_seq,cur_seq,child_p% gr)
+        child_p => child_p % next
+    enddo
+!
+    call Agrif_gl_delete(sorted_child_list)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_create_proc_sequences
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_grids_are_connected( g1, g2 ) result( connection )
+!
+!< Compare required_proc_list for g1 and g2. These are connected if they share a same proc.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(in) :: g1, g2
+!
+    logical :: connection
+    type(Agrif_Proc_p), pointer :: pp1, pp2
+!
+    connection = .false.
+!
+    pp1 => g1 % required_proc_list % first
+!
+    do while( associated(pp1) .and. (.not. connection) )
+!
+        pp2 => g2 % required_proc_list % first
+        do while ( associated(pp2) .and. (.not. connection) )
+            if ( pp1 % proc % pn == pp2 % proc % pn ) then
+            ! if pp1 and pp2 are the same proc, it means that g1 and g2 are connected. We stop here.
+                connection = .true.
+            endif
+            pp2 => pp2 % next
+        enddo
+        pp1 => pp1 % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_grids_are_connected
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_colorize_grid_list ( gridlist ) result ( ncolors )
+!
+!< 1.  Sort nodes in decreasing order of degree.
+!< 2.  Color the node with highest degree with color 1.
+!< 3.  Choose the node with the largest DSAT value. In case of conflict, choose the one with the
+!!       highest degree. Then the one corresponding to the largest grid.
+!< 4.  Color this node with the smallest possible color.
+!< 5.  If all nodes are colored, then stop. Otherwise, go to 3.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)    :: gridlist
+!
+    type(Agrif_Grid_List),   pointer  :: X, Y
+    type(Agrif_PGrid),       pointer  :: gridp
+    type(Agrif_Grid_List),   pointer  :: tmp_gl
+    integer                           :: ncolors
+    integer, dimension(1:gridlist%nitems)   :: colors
+!
+! Be carefull...
+    nullify(Y)
+!
+! First initialize the color of each node
+    gridp => gridlist % first
+    do while ( associated(gridp) )
+        gridp % gr % seq_num = 0
+        gridp => gridp % next
+    enddo
+!
+! Then sort the grids by decreasing degree
+    X => Agrif_gl_merge_sort( gridlist, compare_grid_degrees )
+    gridp => X % first
+!
+! Colorize the first grid in the list
+    gridp % gr % seq_num = 1
+    gridp => gridp % next
+!
+! Then for each of its neighbors...
+    do while ( associated(gridp) )
+!
+        if ( gridp % gr % neigh_list % nitems == 0 ) then
+        ! this grid is alone... let.s attach it to an existing sequence
+            call Agrif_seq_attach_grid( X, gridp % gr )
+            gridp => gridp % next
+            cycle
+        endif
+!
+!     Compute dsat value of all non-colored grids
+        tmp_gl => Agrif_gl_build_from_gp(gridp)
+        call Agrif_seq_calc_dsat(tmp_gl)
+!
+!     Sort non-colored grids by decreasing dsat value, then by size
+        call Agrif_gl_delete(Y)
+        Y => Agrif_gl_merge_sort( tmp_gl, compare_dsat_values, compare_size_values )
+!
+!     Next coloration is for the first grid in this list  TODO : maybe we could find a better choice ..?
+        gridp => Y % first
+!
+!     Assign a color to the chosen grid
+        gridp % gr % seq_num = Agrif_seq_smallest_available_color_in_neighborhood( gridp % gr % neigh_list )
+!
+        gridp => gridp % next
+        call Agrif_gl_delete(tmp_gl)
+!
+    enddo
+!
+    call Agrif_gl_delete(X)
+    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
+    ncolors = maxval(colors)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_colorize_grid_list
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_attach_grid ( gridlist, grid )
+!
+!< 'grid' is not connected to any neighbor. Therefore, we give an existing and well chosen color.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)       :: gridlist
+    type(Agrif_Grid),      intent(inout)    :: grid
+!
+    integer, dimension(gridlist%nitems) :: colors
+    integer, dimension(:), allocatable  :: ngrids_by_color
+    integer :: i, color, ncolors
+!
+    call Agrif_seq_colors_in_neighborhood( gridlist, colors )
+    ncolors = maxval(colors)
+!
+    allocate(ngrids_by_color(ncolors))
+    ngrids_by_color = 0
+!
+    do i = 1,gridlist % nitems
+        if (colors(i) > 0)  ngrids_by_color(colors(i)) = ngrids_by_color(colors(i)) + 1
+    enddo
+!
+    color = ncolors
+    do i = 1,ncolors
+        if ( ngrids_by_color(i) < color ) color = i
+    enddo
+!
+    grid % seq_num = color
+    deallocate(ngrids_by_color)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_attach_grid
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_colors_in_neighborhood ( neigh_list, colors )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: neigh_list
+    integer, dimension(:), intent(out)  :: colors
+!
+    integer                     :: i
+    type(Agrif_PGrid), pointer  :: gridp
+!
+    i = lbound(colors,1)
+    colors = 0
+    gridp => neigh_list % first
+!
+    do while ( associated(gridp) )
+!
+        if ( i > ubound(colors,1) ) then
+            print*,'Error in Agrif_seq_colors_in_neighborhood : "colors" array is too small'
+            stop
+        endif
+        colors(i) = gridp % gr % seq_num
+        gridp => gridp % next
+        i = i+1
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_colors_in_neighborhood
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_smallest_available_color_in_neighborhood ( neigh_list ) result ( smallest )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: neigh_list
+!
+    integer, dimension(:), allocatable :: color_is_met
+    integer     :: colors_tab(1:neigh_list%nitems)
+    integer     :: i, smallest, max_color
+!
+    call Agrif_seq_colors_in_neighborhood( neigh_list, colors_tab )
+    max_color = maxval(colors_tab)
+!
+    allocate(color_is_met(1:max_color))
+    color_is_met = 0
+!
+    do i = 1,neigh_list % nitems
+        if ( colors_tab(i) /= 0 ) then
+            color_is_met(colors_tab(i)) = 1
+        endif
+    enddo
+!
+    smallest = max_color+1
+    do i = 1,max_color
+        if ( color_is_met(i) == 0 ) then
+            smallest = i
+            exit
+        endif
+    enddo
+!
+    deallocate(color_is_met)
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_smallest_available_color_in_neighborhood
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_calc_dsat ( gridlist )
+!< For each node 'v' :
+!<   if none of its neighbors is colored then
+!<       DSAT(v) = degree(v)  #  degree(v) := number of neighbors
+!<   else
+!<       DSAT(v) = number of different colors used in the first neighborhood of v.
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(in)   :: gridlist
+!
+    type(Agrif_PGrid), pointer          :: gridp
+    type(Agrif_Grid),  pointer          :: grid
+    integer, dimension(:), allocatable  :: colors, color_is_met
+    integer                             :: i, ncolors
+!
+    gridp => gridlist % first
+!
+    do while ( associated(gridp) )
+!
+        grid => gridp % gr
+!
+        allocate(colors(grid % neigh_list % nitems))
+        call Agrif_seq_colors_in_neighborhood( grid % neigh_list, colors )
+
+        allocate(color_is_met(1:maxval(colors)))
+        color_is_met = 0
+!
+        do i = 1,grid % neigh_list % nitems
+            if ( colors(i) /= 0 ) then
+                color_is_met(colors(i)) = 1
+            endif
+        enddo
+        ncolors = sum(color_is_met)
+!
+        if ( ncolors == 0 ) then
+            grid % dsat = grid % neigh_list % nitems
+        else
+            grid % dsat = ncolors
+        endif
+        deallocate(colors, color_is_met)
+        gridp => gridp % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_calc_dsat
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_allocate_procs_to_childs ( coarse_grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: coarse_grid
+!
+    integer                         :: is, ip, ig, ngrids
+    type(Agrif_Grid_List), pointer  :: gridlist
+    type(Agrif_PGrid),     pointer  :: gp
+    type(Agrif_Grid),      pointer  :: grid
+    type(Agrif_Proc_List), pointer  :: proclist
+    type(Agrif_Proc),      pointer  :: proc
+    type(Agrif_Proc_p),    pointer  :: pp
+    type(Agrif_Proc), dimension(:), allocatable, target :: procarray
+    type(Agrif_Grid), dimension(:), allocatable         :: gridarray
+    type(Agrif_Sequence_List), pointer :: seqlist
+    real,dimension(:),allocatable :: grid_costs
+    integer,dimension(:), allocatable :: nbprocs_per_grid
+    integer :: i1, i2, j1, j2
+    real :: max_cost
+    integer :: max_index
+!
+    seqlist => coarse_grid % child_seq
+    if ( .not. associated(seqlist) ) return
+!
+! Initialize proc allocation
+    pp => coarse_grid % proc_def_list % first
+    do while ( associated(pp) )
+        pp % proc % grid_id = 0
+        pp => pp % next
+    enddo
+!
+! For each sequence...
+    do is = 1,seqlist % nb_seqs
+!
+        proclist => seqlist % sequences(is) % proclist
+        gridlist => seqlist % sequences(is) % gridlist
+!
+!     Copy coarse grid proc list and convert it to an array
+        call Agrif_pl_deep_copy( coarse_grid % proc_def_list, proclist )
+        call Agrif_pl_to_array ( proclist, procarray )
+!
+!     Allocate a temporary array with concerned grid numbers
+        ngrids = gridlist % nitems
+        allocate(gridarray(1:ngrids))
+        allocate(grid_costs(1:ngrids))
+        allocate(nbprocs_per_grid(1:ngrids))
+
+      nbprocs_per_grid = 0
+!
+!     Allocate required procs to each grid
+        gp => gridlist % first
+        ig = 0
+        do while ( associated(gp) )
+            grid => gp % gr
+            ig = ig+1 ; gridarray(ig) = grid
+            pp => grid % required_proc_list % first
+            do while ( associated(pp) )
+                procarray( pp % proc % pn+1 ) % grid_id = grid % fixedrank
+                nbprocs_per_grid(ig) = nbprocs_per_grid(ig) + 1
+                pp => pp % next
+            enddo
+            gp => gp % next
+        enddo
+!
+!     Add unused procs to the grids
+! TODO FIXME: This is just a dummy allocation. You should take into account grid size and more
+!             information here...
+
+! Estimate current costs
+
+        do ig = 1, ngrids
+          i1 = gridarray(ig)%ix(1)
+          i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
+          j1 = gridarray(ig)%ix(2)
+          j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
+          Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
+          grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
+        enddo
+
+        ig = 1
+        do ip = 1,proclist%nitems
+            if ( procarray( ip ) % grid_id == 0 ) then
+!             this proc is unused
+              max_cost = 0.
+              max_index = 1
+              do ig = 1,ngrids
+                 if (grid_costs(ig) > max_cost) then
+                    max_cost = grid_costs(ig)
+                    max_index = ig
+                 endif
+              enddo
+
+              ig = max_index
+              procarray( ip ) % grid_id = gridarray(ig) % fixedrank
+
+              nbprocs_per_grid(ig) =  nbprocs_per_grid(ig) + 1
+              i1 = gridarray(ig)%ix(1)
+              i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1
+              j1 = gridarray(ig)%ix(2)
+              j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1
+              Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig))
+              grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1)
+
+            endif
+        enddo
+!
+!     Allocate proc nums to each grid
+        gp => gridlist % first
+        do while ( associated(gp) )
+            do ip = 1,proclist%nitems
+                if ( procarray( ip ) % grid_id == gp % gr % fixedrank ) then
+                    allocate(proc)
+                    proc = procarray( ip )
+                    call Agrif_pl_append(gp % gr % proc_def_in_parent_list, proc)
+                endif
+            enddo
+            gp => gp % next
+        enddo
+!
+!     Clean up
+        deallocate(procarray, gridarray, grid_costs, nbprocs_per_grid)
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_allocate_procs_to_childs
+!===================================================================================================
+!
+!===================================================================================================
+subroutine Agrif_seq_create_communicators ( grid )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), intent(inout) :: grid
+!
+    include 'mpif.h'
+    type(Agrif_Sequence_List), pointer  :: seqlist  ! List of child sequences
+    type(Agrif_PGrid), pointer          :: gridp
+    type(Agrif_Proc),  pointer          :: proc
+    integer     :: i, ierr
+    integer     :: current_comm, comm_seq, color_seq
+!
+    seqlist => grid % child_seq
+    if ( .not. associated(seqlist) ) return
+!
+    current_comm = grid % communicator
+    color_seq = MPI_COMM_NULL
+!
+! For each sequence, split the current communicator into as many groups as needed.
+    do i = 1,seqlist % nb_seqs
+!
+!     Loop over each proclist to give a color to the current process
+        gridp => seqlist % sequences(i) % gridlist % first
+        grid_loop : do while ( associated(gridp) )
+            proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
+            if ( associated(proc) ) then
+                if ( gridp % gr % fixedrank /= proc % grid_id ) then
+                    write(*,'("### Error Agrif_seq_create_communicators : ")')
+                    write(*,'("  inconsitancy on proc ",i2,":")') Agrif_Procrank
+                    write(*,'("gr % fixedrank = ",i0,", where proc % grid_id = ",i0)') &
+                            gridp % gr % fixedrank, proc % grid_id
+                    stop
+                endif
+                color_seq = gridp % gr % fixedrank
+                exit grid_loop
+            endif
+            gridp => gridp % next
+        enddo grid_loop
+!
+        call MPI_COMM_SPLIT(current_comm, color_seq, Agrif_ProcRank, comm_seq, ierr)
+        gridp % gr % communicator = comm_seq
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_seq_create_communicators
+!===================================================================================================
+!
+!===================================================================================================
+function Agrif_seq_select_child ( g, is ) result ( gridp )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer, intent(in)   :: g
+    integer,                   intent(in)   :: is
+!
+    type(Agrif_PGrid), pointer  :: gridp
+    type(Agrif_Proc),  pointer  :: proc
+!
+    call Agrif_Instance( g )
+    gridp => g % child_seq % sequences(is) % gridlist % first
+!
+    do while ( associated(gridp) )
+        proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank )
+        if ( associated(proc) ) then
+            return
+        endif
+        gridp => gridp % next
+    enddo
+    write(*,'("### Error Agrif_seq_select_child : no grid found in sequence ",i0," (mother G",i0,") for P",i0)')&
+        is, g%fixedrank, Agrif_Procrank
+    stop
+!---------------------------------------------------------------------------------------------------
+end function Agrif_seq_select_child
+!===================================================================================================
+#else
+    subroutine dummy_Agrif_seq ()
+    end subroutine dummy_Agrif_seq
+#endif
+!
+end module Agrif_seq
Index: vendors/AGRIF/AGRIF_FILES/modtypes.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modtypes.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modtypes.F90	(revision 9621)
@@ -0,0 +1,425 @@
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!
+!
+!> Definition of data types used in AGRIF, of several variables and parameters
+!
+module Agrif_Types
+!
+use Agrif_Procs
+!
+implicit none
+!
+integer, parameter :: Agrif_MaxRaff = 7       !< Maximum refinement ratio
+integer, parameter :: Agrif_NbMaxGrids = 10   !< Maximum number of grids of the hierarchy
+!
+!===================================================================================================
+type Agrif_LRectangle
+!---------------------------------------------------------------------------------------------------
+!<  Data type allowing a grid to reach a grid on the same level or its child grids
+!
+    type(Agrif_Rectangle) , pointer :: r    => NULL()   !< to reach a child grid
+    type(Agrif_LRectangle), pointer :: next => NULL()   !< to reach a grid on the same level
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_LRectangle
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Rectangle
+!---------------------------------------------------------------------------------------------------
+!<  Data type to define several characteristics of a grid (number, position, time and space
+!<  refinement factors, etc).
+!
+    integer                         :: number       !< Number of the grid
+    integer, dimension(3)           :: imin         !< Minimal position in the x,y and z direction
+    integer, dimension(3)           :: imax         !< Maximal position in the x,y and z direction
+    integer, dimension(3)           :: spaceref     !< Space refinement factor in the x,y and z direction
+    integer, dimension(3)           :: timeref      !< Time refinement factor in the x,y and z direction
+    type(Agrif_LRectangle), pointer :: childgrids => NULL()   !< Pointer to reach a grid on the same level or a child grid
+!
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Rectangle
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable), pointer  :: root_var   => NULL()  !< pointer on the variable of the root grid
+    type(Agrif_Variable), pointer  :: parent_var => NULL()  !< pointer on the parent variable
+!
+    integer,   dimension(6)              :: point           !< index of the first point in the
+                                                            !<    real domain (x,y and z direction)
+    integer,   dimension(:), allocatable :: posvar          !< position of the variable on the cell
+                                                            !<   (1 for the boarder of the edge, 2 for the center)
+    integer                            :: interpIndex = -1  !< Indication for the space interpolation (module Agrif_Boundary)
+    integer                            :: nbdim = 0         !< number of dimensions of the grid variable
+    character(1), dimension(:), allocatable :: interptab    !< Array indicating the type of dimension (space or not)
+                                                            !!   for each of them
+    integer,   dimension(:), allocatable :: coords          !< Array indicating the coordinate for each dimension
+                                                            !!   of the array that is refined :
+                                                            !!  'x' -> 1 ; 'y' -> 2 ; 'z' -> 3 ; 'N' -> 0
+
+!> @}
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real,    dimension(:)          , allocatable :: array1
+    real,    dimension(:,:)        , allocatable :: array2
+    real,    dimension(:,:,:)      , allocatable :: array3
+    real,    dimension(:,:,:,:)    , allocatable :: array4
+    real,    dimension(:,:,:,:,:)  , allocatable :: array5
+    real,    dimension(:,:,:,:,:,:), allocatable :: array6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8), dimension(:)          , allocatable :: darray1
+    real(8), dimension(:,:)        , allocatable :: darray2
+    real(8), dimension(:,:,:)      , allocatable :: darray3
+    real(8), dimension(:,:,:,:)    , allocatable :: darray4
+    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
+    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4), dimension(:)          , allocatable :: sarray1
+    real(4), dimension(:,:)        , allocatable :: sarray2
+    real(4), dimension(:,:,:)      , allocatable :: sarray3
+    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
+    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
+    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
+!> @}
+!> \name Arrays used to restore the values
+!> @{
+    integer, dimension(:)          , pointer :: restore1D => NULL()
+    integer, dimension(:,:)        , pointer :: restore2D => NULL()
+    integer, dimension(:,:,:)      , pointer :: restore3D => NULL()
+    integer, dimension(:,:,:,:)    , pointer :: restore4D => NULL()
+    integer, dimension(:,:,:,:,:)  , pointer :: restore5D => NULL()
+    integer, dimension(:,:,:,:,:,:), pointer :: restore6D => NULL()
+!> @}
+
+    real, dimension(:,:), pointer :: oldvalues2D => NULL() !< Array used for the time interpolation
+
+    logical :: restore = .FALSE. !< =1 if the variable should be restored
+    logical :: Interpolationshouldbemade = .FALSE. !< TRUE if the interpolation should be made in any case
+    integer                 :: bcinf !< option bc
+    integer                 :: bcsup !< option bc
+    integer, dimension(6)   :: type_interp    !< option interp
+    integer, dimension(6,6) :: type_interp_bc !< option bcinterp
+    integer, dimension(6)   :: type_update    !< option update
+
+    integer, dimension(6)   :: lb
+    integer, dimension(6)   :: ub
+
+    logical,dimension(6,2) :: memberin
+    integer,dimension(6,2,2,6,2) :: childarray
+
+    type(Agrif_List_Interp_Loc), pointer :: list_interp => NULL()
+    type(Agrif_List_Interp_Loc), pointer :: list_update => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_c
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_c), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_c), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (character)
+!> @{
+    character(2400)                             :: carray0
+    character(200), dimension(:)  , allocatable :: carray1
+    character(200), dimension(:,:), allocatable :: carray2
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_c
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_r
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_r), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_r), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real                                         :: array0
+    real,    dimension(:)          , allocatable :: array1
+    real,    dimension(:,:)        , allocatable :: array2
+    real,    dimension(:,:,:)      , allocatable :: array3
+    real,    dimension(:,:,:,:)    , allocatable :: array4
+    real,    dimension(:,:,:,:,:)  , allocatable :: array5
+    real,    dimension(:,:,:,:,:,:), allocatable :: array6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8)                                      :: darray0
+    real(8), dimension(:)          , allocatable :: darray1
+    real(8), dimension(:,:)        , allocatable :: darray2
+    real(8), dimension(:,:,:)      , allocatable :: darray3
+    real(8), dimension(:,:,:,:)    , allocatable :: darray4
+    real(8), dimension(:,:,:,:,:)  , allocatable :: darray5
+    real(8), dimension(:,:,:,:,:,:), allocatable :: darray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4)                                      :: sarray0
+    real(4), dimension(:)          , allocatable :: sarray1
+    real(4), dimension(:,:)        , allocatable :: sarray2
+    real(4), dimension(:,:,:)      , allocatable :: sarray3
+    real(4), dimension(:,:,:,:)    , allocatable :: sarray4
+    real(4), dimension(:,:,:,:,:)  , allocatable :: sarray5
+    real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_r
+!===================================================================================================
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_l
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_l), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_l), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0                 !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (logical)
+!> @{
+    logical                                      :: larray0
+    logical, dimension(:)          , allocatable :: larray1
+    logical, dimension(:,:)        , allocatable :: larray2
+    logical, dimension(:,:,:)      , allocatable :: larray3
+    logical, dimension(:,:,:,:)    , allocatable :: larray4
+    logical, dimension(:,:,:,:,:)  , allocatable :: larray5
+    logical, dimension(:,:,:,:,:,:), allocatable :: larray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_l
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Variable_i
+!---------------------------------------------------------------------------------------------------
+!<  Data type to characterize a grid variable.
+!
+    type(Agrif_Variable_i), pointer  :: root_var   => NULL()      !< pointer on the variable of the root grid
+    type(Agrif_Variable_i), pointer  :: parent_var => NULL()      !< pointer on the parent variable
+!
+    integer                          :: nbdim = 0             !< number of dimensions of the grid variable
+!
+!> \name Arrays containing the values of the grid variables (integer)
+!> @{
+    integer                                      :: iarray0
+    integer, dimension(:)          , allocatable :: iarray1
+    integer, dimension(:,:)        , allocatable :: iarray2
+    integer, dimension(:,:,:)      , allocatable :: iarray3
+    integer, dimension(:,:,:,:)    , allocatable :: iarray4
+    integer, dimension(:,:,:,:,:)  , allocatable :: iarray5
+    integer, dimension(:,:,:,:,:,:), allocatable :: iarray6
+!> @}
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variable_i
+!===================================================================================================
+!
+!===================================================================================================
+type Agrif_Interp_Loc
+!---------------------------------------------------------------------------------------------------
+    integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99
+    integer,dimension(6)              :: indmin, indmax
+    integer,dimension(6)              :: pttruetab,cetruetab
+    logical :: member, memberin
+#if !defined AGRIF_MPI
+    integer,dimension(6)              :: indminglob,indmaxglob
+#else
+    integer,dimension(6)              :: indminglob2,indmaxglob2
+    integer,dimension(6,2,2)          :: parentarray
+    integer,dimension(:,:,:), pointer :: tab4t          => NULL()
+    integer,dimension(:,:,:), pointer :: tab5t          => NULL()
+    logical, dimension(:),    pointer :: memberinall    => NULL()
+    logical, dimension(:),    pointer :: memberinall2   => NULL()
+    logical, dimension(:),    pointer :: sendtoproc1    => NULL()
+    logical, dimension(:),    pointer :: sendtoproc2    => NULL()
+    logical, dimension(:),    pointer :: recvfromproc1  => NULL()
+    logical, dimension(:),    pointer :: recvfromproc2  => NULL()
+#endif
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Interp_Loc
+!===================================================================================================
+
+!===================================================================================================
+type Agrif_List_Interp_Loc
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Interp_Loc),      pointer :: interp_loc => NULL()
+    type(Agrif_List_Interp_Loc), pointer :: suiv       => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_List_Interp_Loc
+!===================================================================================================
+
+!===================================================================================================
+type Agrif_Variables_List
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),       pointer :: var  => NULL()
+    type(Agrif_Variables_List), pointer :: next => NULL()
+!---------------------------------------------------------------------------------------------------
+end type Agrif_Variables_List
+!===================================================================================================
+!
+!===================================================================================================
+!> Different parameters
+!
+    type(Agrif_Variable),   dimension(:), pointer :: Agrif_tabvars => NULL()
+    type(Agrif_Variable_c), dimension(:), pointer :: Agrif_tabvars_c => NULL()
+    type(Agrif_Variable_r), dimension(:), pointer :: Agrif_tabvars_r => NULL()
+    type(Agrif_Variable_l), dimension(:), pointer :: Agrif_tabvars_l => NULL()
+    type(Agrif_Variable_i), dimension(:), pointer :: Agrif_tabvars_i => NULL()
+!
+    integer               :: Agrif_Probdim          !< Problem dimension
+    integer,dimension(0:4):: Agrif_NbVariables      !< Number of variables
+    integer               :: Agrif_nbfixedgrids     !< Number of fixed grids in the grid hierarchy
+    integer, dimension(3) :: Agrif_coeffref         !< Space refinement factor
+    integer, dimension(3) :: Agrif_coeffreft        !< Time refinement factor
+    logical               :: Agrif_UseSpecialValue          !< T if use special values on the parent grid
+    logical               :: Agrif_UseSpecialValueInUpdate  !< T if use special values on the parent grid
+    logical               :: Agrif_Update_Weights = .FALSE.
+    logical               :: Agrif_UseSpecialValueFineGrid  !< T if use special values on the current grid
+    real                  :: Agrif_SpecialValue             !< Special value on the parent grid
+    real                  :: Agrif_SpecialValueFineGrid     !< Special value on the current grid
+!>
+!> \name Clustering parameters
+!> @{
+    integer               :: Agrif_Regridding = 10
+    integer               :: Agrif_Minwidth
+    real                  :: Agrif_Efficiency = 0.7
+    integer               :: MaxSearch = 5
+    real, dimension(3)    :: Agrif_mind
+!> @}
+!> \name parameters for the interpolation of the child grids
+!> @{
+    integer, parameter    :: Agrif_linear = 1           !< linear interpolation
+    integer, parameter    :: Agrif_lagrange = 2         !< lagrange interpolation
+    integer, parameter    :: Agrif_eno = 3              !< spline interpolation
+    integer, parameter    :: Agrif_user_interp = 4      !< user defined interpolation
+    integer, parameter    :: Agrif_constant = 5         !< constant interpolation
+    integer, parameter    :: Agrif_linearconserv = 6    !< linear conservative interpolation
+    integer, parameter    :: Agrif_linearconservlim = 7 !< linear conservative interpolation
+    integer, parameter    :: Agrif_ppm = 8              !< PPM interpolation
+    integer, parameter    :: Agrif_weno = 9             !< WENO5 interpolation
+    integer, parameter    :: Agrif_ppm_lim = 10         !< PPM interpolation with monotonicity
+!> @}
+!> \name parameters for the update of the parent grids
+!> @{
+    integer, parameter    :: Agrif_Update_Copy = 1              !< copy
+    integer, parameter    :: Agrif_Update_Average = 2           !< average
+    integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting
+!> @}
+!> \name Raffinement grid switches
+!> @{
+    integer               :: Agrif_USE_ONLY_FIXED_GRIDS   !< = 1 if fixed grid mode
+    integer               :: Agrif_USE_FIXED_GRIDS        !< = 1 if AMR mode + fixed grid else only AMR mode
+!> @}
+    integer               :: Agrif_Maxlevelloc
+!
+#if defined AGRIF_MPI
+    integer :: Agrif_Nbprocs  !< Number of processors
+    integer :: Agrif_ProcRank !< Rank of the current processor
+    integer :: Agrif_Group    !< Group associated to Agrif_mpi_comm
+    integer :: Agrif_mpi_comm
+#else
+    integer :: Agrif_ProcRank = 0
+#endif
+!
+    integer :: Agrif_Extra_Boundary_Cells = 3       !< When computing integration sequences, the grid rects
+                                                    !! are expanded to this number of cells.
+    logical :: Agrif_Parallel_sisters = .FALSE.     !< When TRUE, try to compute sister grids (which have the same parent)
+                                                    !! in parallel rather than sequentially.
+    logical :: agrif_regrid_has_been_done = .FALSE. !< switch to skip Agrif_Regrid call
+!
+    real, dimension(:)          , allocatable :: parray1
+    real, dimension(:,:)        , allocatable :: parray2
+    real, dimension(:,:,:)      , allocatable :: parray3
+    real, dimension(:,:,:,:)    , allocatable :: parray4
+    real, dimension(:,:,:,:,:)  , allocatable :: parray5
+    real, dimension(:,:,:,:,:,:), allocatable :: parray6
+!
+    logical :: agrif_debug = .false.    ! may be activaded in users subroutine for debugging purposes
+
+! If a grand mother grid is present
+    logical :: agrif_coarse = .false.
+    integer, dimension(3) :: coarse_spaceref = (/1,1,1/)
+    integer, dimension(3) :: coarse_timeref  = (/1,1,1/)
+!
+contains
+!
+!===================================================================================================
+!  function Agrif_Ceiling
+!---------------------------------------------------------------------------------------------------
+integer function Agrif_Ceiling ( x )
+!---------------------------------------------------------------------------------------------------
+    real,   intent(in) :: x
+!
+    integer   :: i
+!
+    i = FLOOR(x)
+!
+    if( ABS(x - i) <= 0.0001 )then
+        Agrif_Ceiling = i
+    else
+        Agrif_Ceiling = i+1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Ceiling
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Int
+!---------------------------------------------------------------------------------------------------
+    integer function Agrif_Int(x)
+!---------------------------------------------------------------------------------------------------
+    real,   intent(in) :: x
+!
+    integer :: i
+!
+    i = FLOOR(x) + 1
+!
+    if( ABS(x - i) <= 0.0001 )then
+        Agrif_Int = i
+    else
+        Agrif_Int = i-1
+    endif
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Int
+!===================================================================================================
+!
+end module Agrif_Types
Index: vendors/AGRIF/AGRIF_FILES/modupdate.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modupdate.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modupdate.F90	(revision 9621)
@@ -0,0 +1,2130 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_Update
+!>
+!> This module  contains procedures to update a parent grid from its child grids.
+!
+module Agrif_Update
+!
+    use Agrif_UpdateBasic
+    use Agrif_Arrays
+    use Agrif_CurgridFunctions
+    use Agrif_Mask
+#if defined AGRIF_MPI
+    use Agrif_Mpp
+#endif
+!
+    implicit none
+!
+    logical, private :: precomputedone(7) = .FALSE.
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateVariable
+!
+!> subroutine to set arguments for Agrif_UpdatenD
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateVariable ( parent, child, updateinf, updatesup, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),  pointer      :: parent       !< Variable on the parent grid
+    type(Agrif_Variable),  pointer      :: child        !< Variable on the child grid
+    integer, dimension(6), intent(in)   :: updateinf    !< First positions where interpolations are calculated
+    integer, dimension(6), intent(in)   :: updatesup    !< Last  positions where interpolations are calculated
+    procedure()                         :: procname     !< Data recovery procedure
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6) :: nb_child           ! Number of cells on the child grid
+    integer, dimension(6) :: lb_child
+    integer, dimension(6) :: ub_child
+    integer, dimension(6) :: lb_parent
+    real   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0)
+    real   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0)
+    real   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1)
+    real   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1)
+    logical, dimension(6) :: do_update          ! Indicates if we perform update for each dimension
+    integer, dimension(6) :: posvar             ! Position of the variable on the cell (1 or 2)
+    integer, dimension(6) :: oldparentlbound, oldparentubound
+    integer               :: n, nbdim
+    logical               :: wholeupdate
+    type(Agrif_Variable), pointer :: root   ! Variable on the root grid
+!
+    root => child % root_var
+    nbdim = root % nbdim
+!
+    call PreProcessToInterpOrUpdate( parent,   child,       &
+                                     nb_child, ub_child,    &
+                                     lb_child, lb_parent,   &
+                                      s_child,  s_parent,   &
+                                     ds_child, ds_parent, nbdim, interp=.false. )
+!
+    do_update(:) = .true.
+    posvar(1:nbdim) = root % posvar(1:nbdim)
+!
+    do n = 1,nbdim
+!
+        if ( root % interptab(n) == 'N' ) then
+            posvar(n) = 1
+            do_update(n) = .false.
+            oldparentlbound(n) = parent % lb(n)
+            oldparentubound(n) = parent % ub(n)
+            parent % lb(n) = child % lb(n)
+            parent % ub(n) = child % ub(n)
+        end if
+!
+    enddo
+
+    wholeupdate = .FALSE.
+!
+    do n = 1,nbdim
+        if ( do_update(n) ) then
+            if ( (updateinf(n) > updatesup(n)) .OR. &
+                ((updateinf(n) == -99) .AND. (updatesup(n) == -99)) &
+               ) then
+                wholeupdate = .TRUE.
+            endif
+        endif
+    enddo
+!
+    IF (wholeupdate) THEN
+        call Agrif_UpdateWhole(parent, child,               &
+                updateinf(1:nbdim), updatesup(1:nbdim),     &
+                lb_child(1:nbdim), lb_parent(1:nbdim),      &
+                nb_child(1:nbdim), posvar(1:nbdim),         &
+                do_update(1:nbdim),                         &
+                s_child(1:nbdim),   s_parent(1:nbdim),      &
+                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
+    ELSE
+        call Agrif_UpdateBcnD(parent, child,                &
+                updateinf(1:nbdim), updatesup(1:nbdim),     &
+                lb_child(1:nbdim), lb_parent(1:nbdim),      &
+                nb_child(1:nbdim), posvar(1:nbdim),         &
+                do_update(1:nbdim),                         &
+                s_child(1:nbdim),   s_parent(1:nbdim),      &
+                ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname)
+    ENDIF
+!
+    do n = 1,nbdim
+!
+        if ( root % interptab(n) == 'N' ) then  ! No space DIMENSION
+            parent % lb(n) = oldparentlbound(n)
+            parent % ub(n) = oldparentubound(n)
+        end if
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateVariable
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateWhole
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateWhole ( parent, child, uinf, usup,       &
+                               lb_child, lb_parent,             &
+                               nb_child, posvar,                &
+                               do_update,                       &
+                               s_child,   s_parent,             &
+                               ds_child, ds_parent, nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    type(Agrif_Variable),      pointer    :: parent         !< Variable on the parent grid
+    type(Agrif_Variable),      pointer    :: child          !< Variable on the child grid
+    integer, dimension(nbdim), intent(in) :: uinf           !< First positions where interpolations are calculated
+    integer, dimension(nbdim), intent(in) :: usup           !< Last  positions where interpolations are calculated
+    integer,                   intent(in) :: nbdim          !< Number of dimensions of the grid variable
+    integer, dimension(nbdim), intent(in) :: lb_child       !< Index of the first point inside the domain for the parent grid variable
+    integer, dimension(nbdim), intent(in) :: lb_parent      !< Index of the first point inside the domain for the child grid variable
+    integer, dimension(nbdim), intent(in) :: nb_child       !< Number of cells of the child grid
+    integer, dimension(nbdim), intent(in) :: posvar         !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim), intent(in) :: do_update      !< Indicates if we update for each dimension
+    real,    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid
+    real,    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid
+    procedure()                           :: procname       !< Data recovery procedure
+!
+    integer, dimension(nbdim)     :: type_update ! Type of update (copy or average)
+    integer, dimension(nbdim,2)   :: lubglob
+    integer, dimension(nbdim,2,2) :: indtab      ! limits of the child grid that will be used in the update scheme
+    integer, dimension(nbdim,2,2) :: indtruetab  ! grid variable where boundary conditions are
+    integer :: coeffraf, i
+    integer :: uinfloc, usuploc
+!
+    type_update = child % root_var % type_update(1:nbdim)
+!
+    do i = 1, nbdim
+!
+        if ( do_update(i) ) then
+!
+            coeffraf = nint(ds_parent(i)/ds_child(i))
+            uinfloc = 0
+            usuploc = nb_child(i)/coeffraf - 1
+
+            IF (posvar(i) == 1) THEN
+                usuploc = usuploc - 1
+            ENDIF
+
+            IF (uinf(i) > usup(i)) THEN
+                uinfloc = uinf(i)
+                usuploc = usuploc - uinf(i)
+            ENDIF
+
+            indtab(i,1,1) = lb_child(i) + (uinfloc + 1) * coeffraf
+            indtab(i,1,2) = lb_child(i) + (usuploc + 1) * coeffraf
+
+            IF ( posvar(i) == 1 ) THEN
+                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
+                    indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)
+                ELSE IF ( type_update(i) /= Agrif_Update_Copy ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+                ENDIF
+            ELSE
+                indtab(i,1,1) = indtab(i,1,1) - coeffraf
+                indtab(i,1,2) = indtab(i,1,2) - 1
+    ! at this point, indices are OK for an average
+                IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN
+                    indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
+                    indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
+                ENDIF
+            ENDIF
+!
+        else    ! IF ( .not.do_update(i) ) THEN
+!
+            if ( posvar(i) == 1 ) then
+                indtab(i,1,1) = lb_child(i)
+                indtab(i,1,2) = lb_child(i) + nb_child(i)
+            else
+                indtab(i,1,1) = lb_child(i)
+                indtab(i,1,2) = lb_child(i) + nb_child(i) - 1
+            endif
+!
+        endif
+    enddo
+
+! lubglob contains the global lbound and ubound of the child array
+! lubglob(:,1) : global lbound for each dimension
+! lubglob(:,2) : global lbound for each dimension
+!
+    call Agrif_get_var_global_bounds(child, lubglob, nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2), lubglob(1:nbdim,2))
+!
+    call Agrif_UpdatenD(type_update, parent, child,                         &
+                        indtruetab(1:nbdim,1,1), indtruetab(1:nbdim,1,2),   &
+                        lb_child(1:nbdim), lb_parent(1:nbdim),              &
+                        s_child(1:nbdim), s_parent(1:nbdim),                &
+                        ds_child(1:nbdim), ds_parent(1:nbdim),              &
+#if defined AGRIF_MPI
+                        posvar, do_update,                                  &
+#endif
+                        nbdim, procname)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateWhole
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateBcnd
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateBcnd ( parent, child, uinf, usup,        &
+                              lb_child, lb_parent,              &
+                              nb_child, posvar,                 &
+                              do_update,                        &
+                              s_child,  s_parent,               &
+                              ds_child, ds_parent, nbdim, procname )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    type(Agrif_Variable), pointer           :: parent       !< Variable on the parent grid
+    type(Agrif_Variable), pointer           :: child        !< Variable on the child grid
+    integer, dimension(nbdim), intent(in)   :: uinf         !< First positions where interpolations are calculated
+    integer, dimension(nbdim), intent(in)   :: usup         !< Last  positions where interpolations are calculated
+    integer                                 :: nbdim        !< Number of dimensions of the grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_child     !< Index of the first point inside the domain for
+                                                            !!   the parent grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_parent    !< Index of the first point inside the domain for
+                                                            !!   the child grid variable
+    integer, dimension(nbdim), intent(in)   :: nb_child     !< Number of cells of the child grid
+    integer, dimension(nbdim), intent(in)   :: posvar       !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim), intent(in)   :: do_update    !< Indicates if we update for each dimension
+    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    procedure()                             :: procname     !< Data recovery procedure
+!
+    integer,dimension(nbdim)     :: type_update ! Type of update (copy or average)
+    integer,dimension(nbdim,2)   :: lubglob
+    integer                      :: i
+    integer,dimension(nbdim,2,2) :: indtab         ! Arrays indicating the limits of the child
+    integer,dimension(nbdim,2,2) :: indtruetab     ! grid variable where boundary conditions are
+    integer,dimension(nbdim,2,2,nbdim)   :: ptres  ! calculated
+    integer                      :: nb, ndir
+    integer :: coeffraf
+!
+    type_update = child % root_var % type_update(1:nbdim)
+!
+    DO i = 1, nbdim
+        coeffraf = nint(ds_parent(i)/ds_child(i))
+        indtab(i,1,1) = lb_child(i) + (uinf(i) + 1) * coeffraf
+        indtab(i,1,2) = lb_child(i) + (usup(i) + 1) * coeffraf
+
+        indtab(i,2,1) = lb_child(i) + nb_child(i) - (usup(i)+1) *  coeffraf
+        indtab(i,2,2) = lb_child(i) + nb_child(i) - (uinf(i)+1) *  coeffraf
+
+        IF (posvar(i) == 1) THEN
+            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
+                indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)
+            ELSE IF (type_update(i) /= Agrif_Update_Copy) THEN
+                indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
+                indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
+            ENDIF
+        ELSE
+            indtab(i,1,1) = indtab(i,1,1) - coeffraf
+            indtab(i,1,2) = indtab(i,1,2) - 1
+            indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
+            IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
+                indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
+                indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
+                indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
+            ENDIF
+        ENDIF
+    ENDDO
+!
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!
+    indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),lubglob(1:nbdim,1))
+    indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),lubglob(1:nbdim,2))
+    indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),lubglob(1:nbdim,2))
+!
+    do nb = 1,nbdim
+        if ( do_update(nb) ) then
+            do ndir = 1,2
+                ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1)
+                ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2)
+                do i = 1,nbdim
+                    if ( i /= nb ) then
+                        if ( do_update(i) ) then
+                            ptres(i,1,ndir,nb) = indtruetab(i,1,1)
+                            ptres(i,2,ndir,nb) = indtruetab(i,2,2)
+                        else
+                            if (posvar(i) == 1) then
+                                ptres(i,1,ndir,nb) = lb_child(i)
+                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i)
+                            else
+                                ptres(i,1,ndir,nb) = lb_child(i)
+                                ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i) - 1
+                            endif
+                        endif
+                    endif
+                enddo
+            enddo
+        endif
+    enddo
+!
+    do nb = 1,nbdim
+        if ( do_update(nb) ) then
+            do ndir = 1,2
+                call Agrif_UpdatenD(type_update, parent, child,             &
+                        ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),  &
+                        lb_child(1:nbdim),lb_parent(1:nbdim),               &
+                        s_child(1:nbdim),s_parent(1:nbdim),                 &
+                        ds_child(1:nbdim),ds_parent(1:nbdim),               &
+#if defined AGRIF_MPI
+                        posvar,do_update,                                   &
+#endif
+                        nbdim,procname,nb,ndir)
+            enddo
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateBcnd
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdatenD
+!
+!> updates a 2D grid variable on the parent grid of the current grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdatenD ( type_update, parent, child,     &
+                            pttab, petab,                   &
+                            lb_child, lb_parent,            &
+                            s_child,  s_parent,             &
+                            ds_child, ds_parent,            &
+#if defined AGRIF_MPI
+                            posvar, do_update,              &
+#endif
+                            nbdim, procname, nb, ndir )
+!---------------------------------------------------------------------------------------------------
+#if defined AGRIF_MPI
+    include 'mpif.h'
+#endif
+!
+    integer, dimension(6),     intent(in)   :: type_update  !< Type of update (copy or average)
+    type(Agrif_Variable), pointer           :: parent       !< Variable of the parent grid
+    type(Agrif_Variable), pointer           :: child        !< Variable of the child grid
+    integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(in)   :: pttab        !< Index of the first point inside the domain
+    integer, dimension(nbdim), intent(in)   :: petab        !< Index of the first point inside the domain
+    integer, dimension(nbdim), intent(in)   :: lb_child  !< Index of the first point inside the domain for the child
+                                                            !!    grid variable
+    integer, dimension(nbdim), intent(in)   :: lb_parent !< Index of the first point inside the domain for the parent
+                                                            !!    grid variable
+    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    procedure()                             :: procname     !< Data recovery procedure
+    integer, optional,         intent(in)   :: nb, ndir
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(nbdim)       :: pttruetab, cetruetab
+#if defined AGRIF_MPI
+    integer, dimension(nbdim)       :: posvar  !< Position of the variable on the cell (1 or 2)
+    logical, dimension(nbdim)       :: do_update
+#endif
+    integer, dimension(nbdim)       :: coords
+    integer, dimension(nbdim)       :: indmin, indmax
+    integer, dimension(nbdim)       :: indminglob, indmaxglob
+    real   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp
+    integer, dimension(nbdim)       :: lowerbound,upperbound
+    integer, dimension(nbdim)       :: pttruetabwhole, cetruetabwhole
+    integer, dimension(nbdim,2,2)   :: childarray
+    integer, dimension(nbdim,2,2)   :: parentarray
+    integer,dimension(nbdim)     :: type_update_temp
+    logical :: memberin, member
+    integer :: nbin, ndirin
+!
+#if defined AGRIF_MPI
+!
+    integer,dimension(nbdim)    :: indminglob2,indmaxglob2
+    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
+    logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2
+    integer                               :: code, local_proc
+    integer                               :: i,j,k
+    integer, dimension(nbdim,4)           :: tab3
+    integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
+    integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t
+    logical :: find_list_update
+    logical, dimension(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
+    logical, dimension(1) :: memberin1
+!
+#endif
+!
+    type(Agrif_Variable), pointer, save :: tempC => NULL()       ! Temporary child grid variable
+    type(Agrif_Variable), pointer, save :: tempP => NULL()       ! Temporary parent grid variable
+    type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child
+    type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent
+    type(Agrif_Variable), pointer :: tempP_indic, tempP_average
+    type(Agrif_Variable), pointer :: tempC_indic
+    logical :: compute_average
+    real :: coeff_multi
+    integer :: nb_dimensions
+!
+!   Get local lower and upper bound of the child variable
+    call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+
+! here pttab and petab corresponds to the (global) indices of the points needed in the update
+! pttruetab and cetruetab contains only indices that are present on the local processor
+!
+    coords = child % root_var % coords
+!
+    call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank,    &
+                            coords, pttruetab, cetruetab, memberin )
+    call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp,       &
+                         s_child, ds_child, s_parent, ds_parent,                            &
+                         pttab, petab, lb_child, lb_parent                                  &
+#if defined AGRIF_MPI
+                       , posvar, type_update, do_update, pttruetabwhole, cetruetabwhole     &
+#endif
+            )
+
+#if defined AGRIF_MPI
+!
+    IF (memberin) THEN
+        call Agrif_GlobalToLocalBounds(childarray,lowerbound,upperbound,    &
+                                       pttruetab,cetruetab, coords,         &
+                                       nbdim, Agrif_Procrank, member)
+    ENDIF
+
+    call Agrif_Prtbounds(nbdim, indmin, indmax,                     &
+                         s_Parent_temp, s_Child_temp,               &
+                         s_child, ds_child, s_parent, ds_parent,    &
+                         pttruetab, cetruetab, lb_child, lb_parent, &
+                         posvar, type_update, do_update,            &
+                         pttruetabwhole, cetruetabwhole)
+!
+#else
+    indmin = indminglob
+    indmax = indmaxglob
+    pttruetabwhole = pttruetab
+    cetruetabwhole = cetruetab
+    childarray(:,1,2) = pttruetab
+    childarray(:,2,2) = cetruetab
+#endif
+
+    IF (.not.present(nb)) THEN
+        nbin=0
+        ndirin=0
+    ELSE
+        nbin = nb
+        ndirin = ndir
+    ENDIF
+
+    IF (memberin) THEN
+!
+        IF ( .not.associated(tempC) )  allocate(tempC)
+!
+        call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+        call Agrif_var_set_array_tozero(tempC,nbdim)
+
+        SELECT CASE (nbdim)
+        CASE(1)
+            CALL procname(tempC%array1,                 &
+                      childarray(1,1,2),childarray(1,2,2),.TRUE.,nbin,ndirin)
+        CASE(2)
+            CALL procname(tempC%array2,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),.TRUE.,nbin,ndirin)
+        CASE(3)
+            CALL procname(tempC%array3,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),.TRUE.,nbin,ndirin)
+        CASE(4)
+            CALL procname(tempC%array4,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),.TRUE.,nbin,ndirin)
+        CASE(5)
+            CALL procname(tempC%array5,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),  &
+                      childarray(5,1,2),childarray(5,2,2),.TRUE.,nbin,ndirin)
+        CASE(6)
+            CALL procname(tempC%array6,                 &
+                      childarray(1,1,2),childarray(1,2,2),  &
+                      childarray(2,1,2),childarray(2,2,2),  &
+                      childarray(3,1,2),childarray(3,2,2),  &
+                      childarray(4,1,2),childarray(4,2,2),  &
+                      childarray(5,1,2),childarray(5,2,2),  &
+                      childarray(6,1,2),childarray(6,2,2),.TRUE.,nbin,ndirin)
+        END SELECT
+!
+    ENDIF
+!
+#if defined AGRIF_MPI
+!
+!     tab2 contains the necessary limits of the parent grid for each processor
+
+    if (Associated(child%list_update)) then
+        call Agrif_Find_list_update(child%list_update,pttab,petab,                      &
+                                    lb_child,lb_parent,nbdim,                         &
+                                    find_list_update,tab4t,tab5t,memberinall,memberinall2,  &
+                                    sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+    else
+        find_list_update = .FALSE.
+    endif
+
+    if (.not.find_list_update) then
+        tab3(:,1) = pttruetab(:)
+        tab3(:,2) = cetruetab(:)
+        tab3(:,3) = pttruetabwhole(:)
+        tab3(:,4) = cetruetabwhole(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        if ( .not.associated(tempCextend) ) allocate(tempCextend)
+        do k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab4t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = memberin
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+
+        call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),tab4t(:,:,3),tab4t(:,:,4),   &
+                                     nbdim, memberinall, coords,                            &
+                                     sendtoproc1,recvfromproc1,                             &
+                                     tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+    endif
+
+    call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim,         &
+            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),    &
+            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,tempCextend)
+
+#else
+    tempCextend => tempC
+#endif
+!
+!     Update of the parent grid (tempP) from the child grid (tempC)
+!
+    IF (memberin) THEN
+!
+        IF ( .not.associated(tempP) ) allocate(tempP)
+!
+        call Agrif_array_allocate(tempP,indmin,indmax,nbdim)
+!
+        if ( nbdim == 1 ) then
+            tempP % array1 = 0.
+            call Agrif_Update_1D_Recursive( type_update(1),  &
+                                            tempP%array1,   &
+                                            tempCextend%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update(1:nbdim) == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array1),ubound(tempP%array1),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_1D_Recursive( type_update_temp(1),   &
+                                            tempP_average%array1,       &
+                                            tempCextend%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array1 = 0.
+            ELSEWHERE
+              tempC_indic%array1 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_1D_Recursive( type_update_temp(1),   &
+                                            tempP_indic%array1,       &
+                                            tempC_indic%array1, &
+                                            indmin(1), indmax(1),   &
+                                            pttruetabwhole(1), cetruetabwhole(1),   &
+                                            s_Child_temp(1), s_Parent_temp(1),      &
+                                            ds_child(1), ds_parent(1) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array1 == 0.)
+                  tempP%array1 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array1 == coeff_multi).AND.(tempP%array1 /= Agrif_SpecialValueFineGrid))
+                  tempP%array1 = tempP%array1 /tempP_indic%array1
+               ELSEWHERE
+                  tempP%array1 = tempP_average%array1 /tempP_indic%array1
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array1 == 0.)
+                  tempP%array1 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array1 = tempP%array1 /tempP_indic%array1
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array1)
+            deallocate(tempC_indic%array1)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array1)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 2 ) then
+            call Agrif_Update_2D_Recursive( type_update(1:2),   &
+                                            tempP%array2,       &
+                                            tempCextend%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim)
+ 
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array2),ubound(tempP%array2),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
+                                            tempP_average%array2,       &
+                                            tempCextend%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array2 = 0.
+            ELSEWHERE
+              tempC_indic%array2 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+            
+            call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
+                                            tempP_indic%array2,       &
+                                            tempC_indic%array2, &
+                                            indmin(1:2), indmax(1:2),   &
+                                            pttruetabwhole(1:2), cetruetabwhole(1:2),   &
+                                            s_Child_temp(1:2), s_Parent_temp(1:2),      &
+                                            ds_child(1:2), ds_parent(1:2) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array2 == 0.)
+                  tempP%array2 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array2 == coeff_multi).AND.(tempP%array2 /= Agrif_SpecialValueFineGrid))
+                  tempP%array2 = tempP%array2 /tempP_indic%array2
+               ELSEWHERE
+                  tempP%array2 = tempP_average%array2 /tempP_indic%array2
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array2 == 0.)
+                  tempP%array2 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array2 = tempP%array2 /tempP_indic%array2
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array2)
+            deallocate(tempC_indic%array2)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array2)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 3 ) then
+            call Agrif_Update_3D_Recursive( type_update(1:3),   &
+                                            tempP%array3,       &
+                                            tempCextend%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array3),ubound(tempP%array3),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
+                                            tempP_average%array3,       &
+                                            tempCextend%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array3 = 0.
+            ELSEWHERE
+              tempC_indic%array3 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
+                                            tempP_indic%array3,       &
+                                            tempC_indic%array3, &
+                                            indmin(1:3), indmax(1:3),   &
+                                            pttruetabwhole(1:3), cetruetabwhole(1:3),   &
+                                            s_Child_temp(1:3), s_Parent_temp(1:3),      &
+                                            ds_child(1:3), ds_parent(1:3) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array3 == 0.)
+                  tempP%array3 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array3 == coeff_multi).AND.(tempP%array3 /= Agrif_SpecialValueFineGrid))
+                  tempP%array3 = tempP%array3 /tempP_indic%array3
+               ELSEWHERE
+                  tempP%array3 = tempP_average%array3 /tempP_indic%array3
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array3 == 0.)
+                  tempP%array3 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array3 = tempP%array3 /tempP_indic%array3
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array3)
+            deallocate(tempC_indic%array3)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array3)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 4 ) then
+            call Agrif_Update_4D_Recursive( type_update(1:4),   &
+                                            tempP%array4,       &
+                                            tempCextend%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim)
+           
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array4),ubound(tempP%array4),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
+                                            tempP_average%array4,       &
+                                            tempCextend%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array4 = 0.
+            ELSEWHERE
+              tempC_indic%array4 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
+                                            tempP_indic%array4,       &
+                                            tempC_indic%array4, &
+                                            indmin(1:4), indmax(1:4),   &
+                                            pttruetabwhole(1:4), cetruetabwhole(1:4),   &
+                                            s_Child_temp(1:4), s_Parent_temp(1:4),      &
+                                            ds_child(1:4), ds_parent(1:4) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array4 == 0.)
+                  tempP%array4 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array4 == coeff_multi).AND.(tempP%array4 /= Agrif_SpecialValueFineGrid))
+                  tempP%array4 = tempP%array4 /tempP_indic%array4
+               ELSEWHERE
+                  tempP%array4 = tempP_average%array4 /tempP_indic%array4
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array4 == 0.)
+                  tempP%array4 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array4 = tempP%array4 /tempP_indic%array4
+               END WHERE
+            ENDIF
+            deallocate(tempP_indic%array4)
+            deallocate(tempC_indic%array4)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array4)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 5 ) then
+            call Agrif_Update_5D_Recursive( type_update(1:5),   &
+                                            tempP%array5,       &
+                                            tempCextend%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+                                            
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array5),ubound(tempP%array5),nbdim)
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
+                                            tempP_average%array5,       &
+                                            tempCextend%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+            
+            WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid)
+              tempC_indic%array5 = 0.
+            ELSEWHERE
+              tempC_indic%array5 = 1.
+            END WHERE
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
+                                            tempP_indic%array5,       &
+                                            tempC_indic%array5, &
+                                            indmin(1:5), indmax(1:5),   &
+                                            pttruetabwhole(1:5), cetruetabwhole(1:5),   &
+                                            s_Child_temp(1:5), s_Parent_temp(1:5),      &
+                                            ds_child(1:5), ds_parent(1:5) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array5 == 0.)
+                  tempP%array5 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array5 == coeff_multi).AND.(tempP%array5 /= Agrif_SpecialValueFineGrid))
+                  tempP%array5 = tempP%array5 /tempP_indic%array5
+               ELSEWHERE
+                  tempP%array5 = tempP_average%array5 /tempP_indic%array5
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array5 == 0.)
+                  tempP%array5 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array5 = tempP%array5 /tempP_indic%array5
+               END WHERE
+            ENDIF
+           
+            deallocate(tempP_indic%array5)
+            deallocate(tempC_indic%array5)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array5)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+            
+        endif
+        if ( nbdim == 6 ) then
+            call Agrif_Update_6D_Recursive( type_update(1:6),   &
+                                            tempP%array6,       &
+                                            tempCextend%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim)
+            call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim)
+
+            compute_average = .FALSE.
+            type_update_temp(1:nbdim) = type_update(1:nbdim)
+            IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN
+              compute_average = .TRUE.
+              allocate(tempP_average)
+              call Agrif_array_allocate(tempP_average,lbound(tempP%array6),ubound(tempP%array6),nbdim)
+              type_update_temp(1:nbdim) = type_update
+              WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting)
+                type_update_temp(1:nbdim) = Agrif_Update_Average
+              END WHERE
+              call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_average%array6,       &
+                                            tempCextend%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+              coeff_multi = 1.
+              do nb_dimensions=1,nbdim
+                coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions))
+              enddo
+            ENDIF
+
+           IF (compute_average) THEN
+               WHERE (tempP_indic%array6 == 0.)
+                  tempP%array6 = Agrif_SpecialValueFineGrid
+               ELSEWHERE ((tempP_indic%array6 == coeff_multi).AND.(tempP%array6 /= Agrif_SpecialValueFineGrid))
+                  tempP%array6 = tempP%array6 /tempP_indic%array6
+               ELSEWHERE
+                  tempP%array6 = tempP_average%array6 /tempP_indic%array6
+               END WHERE
+
+           ELSE
+               WHERE (tempP_indic%array6 == 0.)
+                  tempP%array6 = Agrif_SpecialValueFineGrid
+               ELSEWHERE
+                  tempP%array6 = tempP%array6 /tempP_indic%array6
+               END WHERE
+            ENDIF
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_indic%array6,       &
+                                            tempC_indic%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
+            WHERE (tempP_indic%array6 == 0.)
+              tempP%array6 = Agrif_SpecialValueFineGrid
+            ELSEWHERE
+              tempP%array6 = tempP%array6 /tempP_indic%array6
+            END WHERE
+           
+            deallocate(tempP_indic%array6)
+            deallocate(tempC_indic%array6)
+            deallocate(tempC_indic)
+            deallocate(tempP_indic)
+            IF (compute_average) THEN
+              deallocate(tempP_average%array6)
+              deallocate(tempP_average)
+            ENDIF
+            ENDIF
+        endif
+!
+        call Agrif_array_deallocate(tempCextend,nbdim)
+!
+    ENDIF
+
+#if defined AGRIF_MPI
+    local_proc = Agrif_Procrank
+    call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+    call Agrif_ChildGrid_to_ParentGrid()
+    call Agrif_Childbounds(nbdim, lowerbound, upperbound,                   &
+                           indminglob,  indmaxglob,  local_proc, coords,    &
+                           indminglob2, indmaxglob2, member)
+!
+    IF (member) THEN
+        call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, &
+                                       indminglob2, indmaxglob2, coords,    &
+                                       nbdim, local_proc, member)
+    ENDIF
+
+    call Agrif_ParentGrid_to_ChildGrid()
+
+    if (.not.find_list_update) then
+        tab3(:,1) = indmin(:)
+        tab3(:,2) = indmax(:)
+        tab3(:,3) = indminglob2(:)
+        tab3(:,4) = indmaxglob2(:)
+!
+        call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
+
+        IF ( .not.associated(tempPextend) ) allocate(tempPextend)
+        DO k=0,Agrif_Nbprocs-1
+            do j=1,4
+                do i=1,nbdim
+                    tab5t(i,k,j) = tab4(i,j,k)
+                enddo
+            enddo
+        enddo
+
+        memberin1(1) = member
+        call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,1,MPI_LOGICAL,Agrif_mpi_comm,code)
+        call Get_External_Data_first(tab5t(:,:,1),tab5t(:,:,2),tab5t(:,:,3),tab5t(:,:,4),   &
+                                     nbdim, memberinall2, coords,                           &
+                                     sendtoproc2, recvfromproc2,                            &
+                                     tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+
+        call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent,      &
+                                     nbdim,tab4t,tab5t,memberinall,memberinall2,            &
+                                     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
+
+    endif
+
+    call ExchangeSameLevel(sendtoproc2,recvfromproc2,nbdim,                     &
+                            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),&
+                            tab5t(:,:,7),tab5t(:,:,8),member,tempP,tempPextend)
+#else
+    tempPextend => tempP
+    parentarray(:,1,1) = indmin
+    parentarray(:,2,1) = indmax
+    parentarray(:,1,2) = indmin
+    parentarray(:,2,2) = indmax
+    member = .TRUE.
+#endif
+!
+!   Special values on the child grid
+    if ( Agrif_UseSpecialValueFineGrid ) then
+!
+!cc         noraftab(1:nbdim) =
+!cc     &    child % root_var % interptab(1:nbdim) == 'N'
+!
+#if defined AGRIF_MPI
+!
+!          allocate(childvalues% var)
+!
+!          Call Agrif_array_allocate(childvalues%var,
+!     &                      pttruetab,cetruetab,nbdim)
+!          Call Agrif_var_full_copy_array(childvalues% var,
+!     &                                tempC,
+!     &                                nbdim)
+!          Call Agrif_CheckMasknD(tempC,childvalues,
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           noraftab(1:nbdim),nbdim)
+!          Call Agrif_array_deallocate(childvalues% var,nbdim)
+!         Deallocate(childvalues % var)
+!
+#else
+!
+!          Call Agrif_get_var_bounds_array(child,
+!     &                              lowerbound,upperbound,nbdim)
+!          Call Agrif_CheckMasknD(tempC,child,
+!     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
+!     &                           lowerbound,
+!     &                           upperbound,
+!     &                           noraftab(1:nbdim),nbdim)
+!
+#endif
+!
+    endif
+!
+!   Special values on the parent grid
+    if (Agrif_UseSpecialValue) then
+!
+#if defined AGRIF_MPI
+!
+!          Call GiveAgrif_SpecialValueToTab_mpi(parent,tempP,
+!     &                 parentarray,
+!     &                 Agrif_SpecialValue,nbdim)
+!
+!
+#else
+!
+!          Call GiveAgrif_SpecialValueToTab(parent,tempP,
+!     &                  indmin,indmax,
+!     &                  Agrif_SpecialValue,nbdim)
+!
+#endif
+!
+    endif
+!
+    IF (member) THEN
+
+        call Agrif_ChildGrid_to_ParentGrid()
+!
+        SELECT CASE(nbdim)
+        CASE(1)
+            call procname( tempPextend % array1(            &
+                    parentarray(1,1,1):parentarray(1,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin)
+        CASE(2)
+            call procname( tempPextend % array2(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin)
+        CASE(3)
+            call procname( tempPextend % array3(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin)
+        CASE(4)
+            call procname( tempPextend % array4(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin)
+        CASE(5)
+            call procname( tempPextend % array5(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1),  &
+                    parentarray(5,1,1):parentarray(5,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),  &
+                    parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin)
+        CASE(6)
+            call procname( tempPextend % array6(            &
+                    parentarray(1,1,1):parentarray(1,2,1),  &
+                    parentarray(2,1,1):parentarray(2,2,1),  &
+                    parentarray(3,1,1):parentarray(3,2,1),  &
+                    parentarray(4,1,1):parentarray(4,2,1),  &
+                    parentarray(5,1,1):parentarray(5,2,1),  &
+                    parentarray(6,1,1):parentarray(6,2,1)), &
+                    parentarray(1,1,2),parentarray(1,2,2),  &
+                    parentarray(2,1,2),parentarray(2,2,2),  &
+                    parentarray(3,1,2),parentarray(3,2,2),  &
+                    parentarray(4,1,2),parentarray(4,2,2),  &
+                    parentarray(5,1,2),parentarray(5,2,2),  &
+                    parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin)
+        END SELECT
+!
+        call Agrif_ParentGrid_to_ChildGrid()
+!
+        call Agrif_array_deallocate(tempPextend,nbdim)
+!
+    ENDIF
+!
+#if defined AGRIF_MPI
+    IF (memberin) THEN
+        call Agrif_array_deallocate(tempP,nbdim)
+        call Agrif_array_deallocate(tempC,nbdim)
+    ENDIF
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdatenD
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Prtbounds
+!
+!> calculates the bounds of the parent grid to be updated by the child grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Prtbounds ( nbdim, indmin, indmax, s_Parent_temp, s_Child_temp,        &
+                             s_child, ds_child, s_parent, ds_parent,                    &
+                             pttruetab, cetruetab, lb_child, lb_parent            &
+#if defined AGRIF_MPI
+                            ,posvar, type_update, do_update,                &
+                             pttruetabwhole, cetruetabwhole                             &
+#endif
+                )
+!---------------------------------------------------------------------------------------------------
+    integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(out)  :: indmin, indmax
+    real,    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp
+    real,    dimension(nbdim), intent(in)   :: s_child,  ds_child
+    real,    dimension(nbdim), intent(in)   :: s_parent, ds_parent
+    integer, dimension(nbdim), intent(in)   :: pttruetab, cetruetab
+    integer, dimension(nbdim), intent(in)   :: lb_child, lb_parent
+#if defined AGRIF_MPI
+    integer, dimension(nbdim), intent(in)   :: posvar   !< Position of the variable on the cell (1 or 2)
+    integer, dimension(nbdim), intent(in)   :: type_update
+    logical, dimension(nbdim), intent(in)   :: do_update
+    integer,dimension(nbdim), intent(out)   :: pttruetabwhole, cetruetabwhole
+#endif
+!
+    real,dimension(nbdim) :: dim_newmin,dim_newmax
+    integer :: i
+#if defined AGRIF_MPI
+    real    :: positionmin, positionmax
+    integer :: imin, imax
+    integer :: coeffraf
+#endif
+!
+    do i = 1,nbdim
+!
+        dim_newmin(i) = s_child(i) + (pttruetab(i) - lb_child(i)) * ds_child(i)
+        dim_newmax(i) = s_child(i) + (cetruetab(i) - lb_child(i)) * ds_child(i)
+!
+        indmin(i) = lb_parent(i) + agrif_ceiling((dim_newmin(i)-s_parent(i))/ds_parent(i))
+        indmax(i) = lb_parent(i) + agrif_int(    (dim_newmax(i)-s_parent(i))/ds_parent(i))
+!
+#if defined AGRIF_MPI
+        positionmin = s_parent(i) + (indmin(i)-lb_parent(i))*ds_parent(i)
+        IF ( do_update(i) ) THEN
+            IF (posvar(i) == 1) THEN
+                IF      (type_update(i) == Agrif_Update_Average) THEN
+                    positionmin = positionmin - ds_parent(i)/2.
+                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                    positionmin = positionmin - (ds_parent(i)-ds_child(i))
+                ENDIF
+            ELSE
+                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
+                    positionmin = positionmin - ds_parent(i)/2.
+                ELSE
+                    coeffraf = nint(ds_parent(i)/ds_child(i))
+                    if (mod(coeffraf,2) == 1) then
+                        positionmin = positionmin - (ds_parent(i)-ds_child(i))
+                    else
+                        positionmin = positionmin - (ds_parent(i)-ds_child(i))-ds_child(i)/2.
+                    endif
+                ENDIF
+            ENDIF
+        ENDIF
+!
+        imin = lb_child(i) + agrif_ceiling((positionmin-s_child(i))/ds_child(i))
+        positionmin = s_child(i)  + (imin - lb_child(i)) * ds_child(i)
+        positionmax = s_parent(i) + (indmax(i)-lb_parent(i))*ds_parent(i)
+        pttruetabwhole(i) = imin
+
+        IF ( do_update(i) ) THEN
+            IF (posvar(i) == 1) THEN
+                IF      (type_update(i) == Agrif_Update_Average) THEN
+                    positionmax = positionmax  + ds_parent(i)/2.
+                ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
+                    positionmax = positionmax  + (ds_parent(i)-ds_child(i))
+                ENDIF
+            ELSE
+                IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN
+                    positionmax = positionmax  + ds_parent(i)/2.
+                ELSE
+                    coeffraf = nint(ds_parent(i)/ds_child(i))
+                    if (mod(coeffraf,2) == 1) then
+                        positionmax = positionmax + (ds_parent(i)-ds_child(i))
+                    else
+                        positionmax = positionmax + (ds_parent(i)-ds_child(i)) + ds_child(i)/2.
+                    endif
+                ENDIF
+            ENDIF
+        ENDIF
+
+        imax = lb_child(i) +agrif_int((positionmax-s_child(i))/ds_child(i))
+        positionmax = s_child(i) + (imax - lb_child(i)) * ds_child(i)
+        cetruetabwhole(i) = imax
+#endif
+!
+        s_Parent_temp(i) = s_parent(i) + (indmin(i) - lb_parent(i)) * ds_parent(i)
+        s_Child_temp(i)  = dim_newmin(i)
+
+#if defined AGRIF_MPI
+        s_Child_temp(i) = positionmin
+#endif
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Prtbounds
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_1D_Recursive
+!
+!> Updates a 1D grid variable on the parent grid
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_1D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                       s_child,  s_parent,  &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer,                            intent(in)  :: type_update            !< Type of update (copy or average)
+    integer,                            intent(in)  :: indmin, indmax
+    integer,                            intent(in)  :: lb_child, ub_child
+    real,                               intent(in)  ::  s_child,  s_parent
+    real,                               intent(in)  :: ds_child, ds_parent
+    real, dimension(indmin:indmax),     intent(out) :: tempP
+    real, dimension(lb_child:ub_child), intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    call Agrif_UpdateBase(type_update,              &
+                          tempP(indmin:indmax),     &
+                          tempC(lb_child:ub_child), &
+                          indmin, indmax,           &
+                          lb_child, ub_child,       &
+                          s_parent, s_child,        &
+                          ds_parent, ds_child)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_1D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_2D_Recursive
+!
+!> updates a 2D grid variable on the parent grid.
+!! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_2D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(2),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(2),          intent(in)  :: indmin, indmax
+    integer, dimension(2),          intent(in)  :: lb_child, ub_child
+    real,    dimension(2),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(2),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2)),       intent(out) :: tempP
+    real,    dimension(:,:),        intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
+    real, dimension(indmin(2):indmax(2), indmin(1):indmax(1))     :: tempP_trsp
+    real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp
+    integer :: i, j
+    integer :: coeffraf
+!
+    tabtemp = 0.
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    IF((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(1) ) then
+            call Average1dPrecompute( ub_child(2)-lb_child(2)+1,    &
+                                      indmax(1)-indmin(1)+1,              &
+                                      ub_child(1)-lb_child(1)+1,    &
+                                      s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!            precomputedone(1) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), &
+                    s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!
+    ELSE IF ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 ))THEN
+!---CDIR NEXPAND
+         if ( .NOT. precomputedone(1) ) then
+            call Agrif_basicupdate_copy1d_before( ub_child(2)-lb_child(2)+1, &
+                                   indmax(1)-indmin(1)+1,           &
+                                   ub_child(1)-lb_child(1)+1, &
+                                   s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+!            precomputedone(1) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1)
+!
+    ELSE
+        do j = lb_child(2),ub_child(2)
+!
+!---CDIR NEXPAND
+            call Agrif_Update_1D_Recursive( type_update(1),             &
+                                            tabtemp(:,j),               &
+                                            tempC(:,j-lb_child(2)+1),   &
+                                            indmin(1), indmax(1),       &
+                                            lb_child(1),ub_child(1),    &
+                                            s_child(1),  s_parent(1),   &
+                                            ds_child(1),ds_parent(1))
+        enddo
+    ENDIF
+!
+    tabtemp_trsp = TRANSPOSE(tabtemp)
+    coeffraf = nint(ds_parent(2)/ds_child(2))
+!
+    tempP_trsp = 0.
+!
+    IF((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(2) ) then
+            call Average1dPrecompute( indmax(1)-indmin(1)+1,          &
+                                      indmax(2)-indmin(2)+1,          &
+                                      ub_child(2)-lb_child(2)+1,&
+                                      s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!            precomputedone(2) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Average1dAfterCompute( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),&
+                s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!
+    ELSE IF ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) THEN
+!---CDIR NEXPAND
+        if ( .NOT. precomputedone(2) ) then
+            call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,             &
+                                   indmax(2)-indmin(2)+1,             &
+                                   ub_child(2)-lb_child(2)+1,   &
+                                   s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+!            precomputedone(2) = .TRUE.
+        endif
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_after( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),2)
+!
+    ELSE
+        do i = indmin(1),indmax(1)
+!
+!---CDIR NEXPAND
+            call Agrif_UpdateBase(type_update(2),                                       &
+                                  tempP_trsp(indmin(2):indmax(2),i),            &
+                                  tabtemp_trsp(lb_child(2):ub_child(2),i),&
+                                  indmin(2),indmax(2),                          &
+                                  lb_child(2),ub_child(2),                &
+                                  s_parent(2),s_child(2),                       &
+                                  ds_parent(2),ds_child(2))
+!
+        enddo
+    ENDIF
+!
+    tempP = TRANSPOSE(tempP_trsp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_2D_Recursive
+!===================================================================================================
+!
+subroutine Agrif_Update_2D_Recursive_ok ( type_update, &
+                                        tempP, tempC, &
+                                        indmin, indmax,   &
+                                       lb_child, ub_child,                    &
+                                       s_child, s_parent, ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, DIMENSION(2), intent(in)   :: type_update            !< Type of update (copy or average)
+    INTEGER, DIMENSION(2), intent(in)   :: indmin, indmax
+    INTEGER, DIMENSION(2), intent(in)   :: lb_child, ub_child
+    REAL,    DIMENSION(2), intent(in)   :: s_child,  s_parent
+    REAL,    DIMENSION(2), intent(in)   :: ds_child, ds_parent
+    REAL,    DIMENSION(                 &
+                indmin(1):indmax(1),    &
+                indmin(2):indmax(2)),           intent(out) :: tempP
+    REAL, DIMENSION(                            &
+                lb_child(1):ub_child(1),  &
+                lb_child(2):ub_child(2)), intent(in)  :: tempC
+!
+    REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
+    INTEGER :: i
+!
+    do i = lb_child(2),ub_child(2)
+        call Agrif_Update_1D_Recursive(type_update(1),                              &
+                                       tabtemp(:, i),          &
+                                       tempC(:,i),  &
+                                       indmin(1),indmax(1),                 &
+                                       lb_child(1),ub_child(1),       &
+                                       s_child(1), s_parent(1),             &
+                                      ds_child(1),ds_parent(1))
+    enddo
+!
+    tempP = 0.
+!
+    do i = indmin(1),indmax(1)
+        call Agrif_UpdateBase(type_update(2),                                       &
+                              tempP(i,:),             &
+                              tabtemp(i,:), &
+                              indmin(2),indmax(2),                          &
+                              lb_child(2),ub_child(2),                &
+                              s_parent(2),s_child(2),                       &
+                             ds_parent(2),ds_child(2))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_2D_Recursive_ok
+!===================================================================================================
+
+!
+!===================================================================================================
+!  subroutine Agrif_Update_3D_Recursive
+!
+!> Updates a 3D grid variable on the parent grid.
+!! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_3D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(3),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(3),          intent(in)  :: indmin, indmax
+    integer, dimension(3),          intent(in)  :: lb_child, ub_child
+    real,    dimension(3),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(3),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(            &
+        indmin(1):indmax(1),    &
+        indmin(2):indmax(2),    &
+        lb_child(3):ub_child(3))    :: tabtemp
+    integer :: i,j,k
+    integer :: coeffraf,locind_child_left
+    integer :: kuinf
+!
+    coeffraf = nint ( ds_parent(1) / ds_child(1) )
+!
+    if ((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Average1dPrecompute(ub_child(2)-lb_child(2)+1,&
+                                 indmax(1)-indmin(1)+1,&
+                                 ub_child(1)-lb_child(1)+1,&
+                                 s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    else if ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+         call Agrif_basicupdate_copy1d_before(ub_child(2)-lb_child(2)+1, &
+                               indmax(1)-indmin(1)+1,           &
+                               ub_child(1)-lb_child(1)+1, &
+                               s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
+        precomputedone(1) = .TRUE.
+    endif
+!
+    coeffraf = nint ( ds_parent(2) / ds_child(2) )
+!
+    if ((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Average1dPrecompute(indmax(1)-indmin(1)+1,&
+                                 indmax(2)-indmin(2)+1,&
+                                 ub_child(2)-lb_child(2)+1,&
+                                 s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    else if ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then
+!---CDIR NEXPAND
+        call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1,           &
+                               indmax(2)-indmin(2)+1,           &
+                               ub_child(2)-lb_child(2)+1, &
+                               s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
+        precomputedone(2) = .TRUE.
+    endif
+!
+    do k = lb_child(3),ub_child(3)
+        call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), &
+                                        indmin(1:2),indmax(1:2),                &
+                                        lb_child(1:2),ub_child(1:2),      &
+                                        s_child(1:2),s_parent(1:2),             &
+                                        ds_child(1:2),ds_parent(1:2) )
+    enddo
+!
+    precomputedone(1) = .FALSE.
+    precomputedone(2) = .FALSE.
+!
+    coeffraf = nint ( ds_parent(3) / ds_child(3) )
+    locind_child_left = 1 + agrif_int((s_parent(3)-s_child(3))/ds_child(3))
+!
+    if (coeffraf == 1) then
+        kuinf = lb_child(3)+locind_child_left-2
+        do k=indmin(3),indmax(3)
+            kuinf = kuinf + 1
+            do j = indmin(2),indmax(2)
+            do i = indmin(1),indmax(1)
+                tempP(i,j,k) = tabtemp(i,j,kuinf)
+            enddo
+            enddo
+        enddo
+    else
+        tempP = 0.
+        do j = indmin(2),indmax(2)
+        do i = indmin(1),indmax(1)
+            call Agrif_UpdateBase(type_update(3),tempP(i,j,:),tabtemp(i,j,:),   &
+                                  indmin(3),indmax(3),                  &
+                                  lb_child(3),ub_child(3),        &
+                                  s_parent(3),s_child(3),               &
+                                  ds_parent(3),ds_child(3))
+!
+        enddo
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_3D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_4D_Recursive
+!
+!> Updates a 4D grid variable on the parent grid.
+!! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_4D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(4),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(4),          intent(in)  :: indmin, indmax
+    integer, dimension(4),          intent(in)  :: lb_child, ub_child
+    real,    dimension(4),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(4),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:), allocatable       :: tabtemp
+    integer :: i,j,k,l
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     lb_child(4):ub_child(4)))
+!
+    do l = lb_child(4), ub_child(4)
+        call Agrif_Update_3D_Recursive(type_update(1:3),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3), l),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3), l),   &
+                                       indmin(1:3), indmax(1:3),            &
+                                       lb_child(1:3), ub_child(1:3),        &
+                                        s_child(1:3),  s_parent(1:3),       &
+                                       ds_child(1:3), ds_parent(1:3))
+    enddo
+!
+    tempP = 0.
+!
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase(type_update(4),                               &
+                              tempP(i,j,k,indmin(4):indmax(4)),             &
+                              tabtemp(i,j,k,lb_child(4):ub_child(4)),       &
+                              indmin(4), indmax(4),                         &
+                              lb_child(4), ub_child(4),                     &
+                               s_parent(4), s_child(4),                     &
+                              ds_parent(4),ds_child(4) )
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_4D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_5D_Recursive
+!
+!> Updates a 5D grid variable on the parent grid.
+!! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_5D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(5),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(5),          intent(in)  :: indmin, indmax
+    integer, dimension(5),          intent(in)  :: lb_child, ub_child
+    real,    dimension(5),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(5),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4),     &
+        indmin(5):indmax(5)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4), &
+        lb_child(5):ub_child(5)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:,:), allocatable     :: tabtemp
+    integer :: i,j,k,l,m
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     indmin(4):indmax(4), &
+                     lb_child(5):ub_child(5)))
+!
+    do m = lb_child(5), ub_child(5)
+        call Agrif_Update_4D_Recursive(type_update(1:4),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3),         &
+                                               indmin(4):indmax(4), m),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4), m),   &
+                                       indmin(1:4),indmax(1:4),             &
+                                       lb_child(1:4), ub_child(1:4),        &
+                                        s_child(1:4), s_parent(1:4),        &
+                                       ds_child(1:4), ds_parent(1:4))
+    enddo
+!
+    tempP = 0.
+!
+    do l = indmin(4), indmax(4)
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase( type_update(5),                              &
+                               tempP(i,j,k,l,indmin(5):indmax(5)),          &
+                               tabtemp(i,j,k,l,lb_child(5):ub_child(5)),    &
+                               indmin(5), indmax(5),                        &
+                               lb_child(5), ub_child(5),                    &
+                                s_parent(5), s_child(5),                    &
+                               ds_parent(5),ds_child(5) )
+    enddo
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_5D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Update_6D_Recursive
+!
+!> Updates a 6D grid variable on the parent grid.
+!! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Update_6D_Recursive ( type_update,         &
+                                       tempP, tempC,        &
+                                       indmin, indmax,      &
+                                       lb_child, ub_child,  &
+                                        s_child,  s_parent, &
+                                       ds_child, ds_parent )
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(6),          intent(in)  :: type_update            !< Type of update (copy or average)
+    integer, dimension(6),          intent(in)  :: indmin, indmax
+    integer, dimension(6),          intent(in)  :: lb_child, ub_child
+    real,    dimension(6),          intent(in)  ::  s_child,  s_parent
+    real,    dimension(6),          intent(in)  :: ds_child, ds_parent
+    real,    dimension(          &
+        indmin(1):indmax(1),     &
+        indmin(2):indmax(2),     &
+        indmin(3):indmax(3),     &
+        indmin(4):indmax(4),     &
+        indmin(5):indmax(5),     &
+        indmin(6):indmax(6)),       intent(out) :: tempP
+    real, dimension(             &
+        lb_child(1):ub_child(1), &
+        lb_child(2):ub_child(2), &
+        lb_child(3):ub_child(3), &
+        lb_child(4):ub_child(4), &
+        lb_child(5):ub_child(5), &
+        lb_child(6):ub_child(6)),   intent(in)  :: tempC
+!---------------------------------------------------------------------------------------------------
+    real, dimension(:,:,:,:,:,:), allocatable   :: tabtemp
+    integer :: i,j,k,l,m,n
+!
+    allocate(tabtemp(indmin(1):indmax(1), &
+                     indmin(2):indmax(2), &
+                     indmin(3):indmax(3), &
+                     indmin(4):indmax(4), &
+                     indmin(5):indmax(5), &
+                     lb_child(6):ub_child(6)))
+!
+    do n = lb_child(6),ub_child(6)
+        call Agrif_Update_5D_Recursive(type_update(1:5),                    &
+                                       tabtemp(indmin(1):indmax(1),         &
+                                               indmin(2):indmax(2),         &
+                                               indmin(3):indmax(3),         &
+                                               indmin(4):indmax(4),         &
+                                               indmin(5):indmax(5), n),     &
+                                       tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4),       &
+                                             lb_child(5):ub_child(5), n),   &
+                                       indmin(1:5), indmax(1:5),            &
+                                       lb_child(1:5),ub_child(1:5),         &
+                                       s_child(1:5), s_parent(1:5),         &
+                                      ds_child(1:5),ds_parent(1:5))
+    enddo
+!
+    tempP = 0.
+!
+    do m = indmin(5), indmax(5)
+    do l = indmin(4), indmax(4)
+    do k = indmin(3), indmax(3)
+    do j = indmin(2), indmax(2)
+    do i = indmin(1), indmax(1)
+        call Agrif_UpdateBase( type_update(6),                              &
+                               tempP(i,j,k,l,m,indmin(6):indmax(6)),        &
+                               tabtemp(i,j,k,l,m,lb_child(6):ub_child(6)),  &
+                               indmin(6), indmax(6),                        &
+                               lb_child(6),  ub_child(6),                   &
+                                s_parent(6),  s_child(6),                   &
+                               ds_parent(6), ds_child(6) )
+    enddo
+    enddo
+    enddo
+    enddo
+    enddo
+!
+    deallocate(tabtemp)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Update_6D_Recursive
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_UpdateBase
+!
+!> Calls the updating method chosen by the user (copy, average or full-weighting).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_UpdateBase ( type_update,              &
+                              parent_tab, child_tab,    &
+                              indmin, indmax,           &
+                              lb_child, ub_child,       &
+                              s_parent, s_child,        &
+                              ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    integer,                            intent(in) :: type_update
+    integer,                            intent(in) :: indmin, indmax
+    integer,                            intent(in) :: lb_child, ub_child
+    real, dimension(indmin:indmax),     intent(out):: parent_tab
+    real, dimension(lb_child:ub_child), intent(in) :: child_tab
+    real,                               intent(in) :: s_parent,  s_child
+    real,                               intent(in) :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    integer :: np       ! Length of parent array
+    integer :: nc       ! Length of child  array
+!
+    np = indmax - indmin + 1
+    nc = ub_child - lb_child + 1
+!
+    if     ( type_update == Agrif_Update_Copy ) then
+!
+        call Agrif_basicupdate_copy1d(              &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                    s_parent,  s_child,             &
+                    ds_parent, ds_child )
+!
+    elseif ( type_update == Agrif_Update_Average ) then
+!
+        call Agrif_basicupdate_average1d(           &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                     s_parent,  s_child,            &
+                    ds_parent, ds_child )
+!
+    elseif ( type_update == Agrif_Update_Full_Weighting ) then
+!
+        call Agrif_basicupdate_full_weighting1D(    &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                    s_parent,  s_child,             &
+                    ds_parent, ds_child )
+!
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_UpdateBase
+!===================================================================================================
+!
+#if defined AGRIF_MPI
+!===================================================================================================
+!  subroutine Agrif_Find_list_update
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Find_list_update ( list_update, pttab, petab, lb_child, lb_parent, nbdim, &
+                                    find_list_update, tab4t, tab5t, memberinall, memberinall2,   &
+                                    sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_List_Interp_Loc),                   pointer     :: list_update
+    INTEGER,                                       intent(in)  :: nbdim
+    INTEGER, DIMENSION(nbdim),                     intent(in)  :: pttab, petab
+    INTEGER, DIMENSION(nbdim),                     intent(in)  :: lb_child, lb_parent
+    LOGICAL,                                       intent(out) :: find_list_update
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab5t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: memberinall,memberinall2
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc1,recvfromproc1
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc2,recvfromproc2
+!
+    Type(Agrif_List_Interp_Loc), Pointer :: parcours
+    INTEGER :: i
+!
+    find_list_update = .FALSE.
+!
+    parcours => list_update
+
+    Find_loop :  do while ( associated(parcours) )
+        do i = 1,nbdim
+            IF ((pttab(i) /= parcours%interp_loc%pttab(i)) .OR. &
+                (petab(i) /= parcours%interp_loc%petab(i)) .OR. &
+                (lb_child(i)  /= parcours%interp_loc%pttab_child(i)) .OR. &
+                (lb_parent(i) /= parcours%interp_loc%pttab_parent(i))) THEN
+                parcours => parcours%suiv
+                cycle Find_loop
+            ENDIF
+        enddo
+!
+        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
+        memberinall  =  parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
+        memberinall2 =  parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
+        sendtoproc1 =   parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)
+        sendtoproc2 =   parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)
+        recvfromproc1 = parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)
+        recvfromproc2 = parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)
+!
+        find_list_update = .TRUE.
+        exit Find_loop
+!
+    enddo Find_loop
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Find_list_update
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_AddTo_list_update
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_AddTo_list_update ( list_update, pttab, petab, lb_child, lb_parent,  &
+                                     nbdim, tab4t, tab5t, memberinall, memberinall2,        &
+                                     sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_List_Interp_Loc), pointer :: list_update
+    INTEGER,                                        intent(in) :: nbdim
+    INTEGER, DIMENSION(nbdim),                      intent(in) :: pttab, petab
+    INTEGER, DIMENSION(nbdim),                      intent(in) :: lb_child, lb_parent
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab4t
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8),  intent(in) :: tab5t
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: memberinall, memberinall2
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc1, recvfromproc1
+    LOGICAL, DIMENSION(0:Agrif_Nbprocs-1),          intent(in) :: sendtoproc2, recvfromproc2
+!
+    Type(Agrif_List_Interp_Loc), pointer :: parcours
+!
+    allocate(parcours)
+    allocate(parcours%interp_loc)
+
+    parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
+    parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
+    parcours%interp_loc%pttab_child(1:nbdim)  = lb_child(1:nbdim)
+    parcours%interp_loc%pttab_parent(1:nbdim) = lb_parent(1:nbdim)
+
+    allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
+    allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
+
+    allocate(parcours%interp_loc%memberinall (0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
+
+    allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
+    allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
+
+    parcours%interp_loc%tab4t = tab4t
+    parcours%interp_loc%tab5t = tab5t
+    parcours%interp_loc%memberinall   = memberinall
+    parcours%interp_loc%memberinall2  = memberinall2
+    parcours%interp_loc%sendtoproc1   = sendtoproc1
+    parcours%interp_loc%sendtoproc2   = sendtoproc2
+    parcours%interp_loc%recvfromproc1 = recvfromproc1
+    parcours%interp_loc%recvfromproc2 = recvfromproc2
+
+    parcours%suiv => list_update
+    list_update => parcours
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Addto_list_update
+!===================================================================================================
+#endif
+!
+end module Agrif_Update
Index: vendors/AGRIF/AGRIF_FILES/modupdatebasic.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modupdatebasic.F90	(revision 9621)
@@ -0,0 +1,434 @@
+!
+! $Id$
+!
+!     AGRIF (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place -  Suite 330, Boston, MA 02111-1307, USA.
+!
+!
+!
+!> Module containing different procedures of update (copy, average, full_weighting)
+!! used in the #Agrif_Update module.
+!===================================================================================================
+!
+module Agrif_UpdateBasic
+!
+    use Agrif_Types
+
+    implicit none
+
+    integer, dimension(:,:), allocatable :: indchildcopy
+    integer, dimension(:,:), allocatable :: indchildaverage
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d
+!
+!> Carries out a copy on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
+    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+!---------------------------------------------------------------------------------------------------
+    integer :: i, locind_child_left, coeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+!
+    if ( coeffraf == 1 ) then
+!CDIR ALTCODE
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+!CDIR ALTCODE
+    do i = 1,np
+        x(i) = y(locind_child_left)
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d_before
+!
+!> Precomputes index for a copy on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d_before ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: nc2          !< Length of parent array
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+    integer,             intent(in)     :: dir          !< Direction
+!---------------------------------------------------------------------------------------------------
+    integer, dimension(:,:), allocatable    :: indchildcopy_tmp
+    integer :: i, n_old, locind_child_left, coeffraf
+!
+    coeffraf = nint(ds_parent/ds_child)
+!
+    locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+
+    if ( .not.allocated(indchildcopy) ) then
+        allocate(indchildcopy(np*nc2, 3))
+    else
+        n_old = size(indchildcopy,1)
+        if ( n_old < np*nc2 ) then
+            allocate( indchildcopy_tmp(1:n_old, 3))
+            indchildcopy_tmp = indchildcopy
+            deallocate(indchildcopy)
+            allocate(indchildcopy(np*nc2, 3))
+            indchildcopy(1:n_old,:) = indchildcopy_tmp
+            deallocate(indchildcopy_tmp)
+        endif
+    endif
+!
+    do i = 1,np
+        indchildcopy(i,dir) = locind_child_left
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!
+    do i = 2,nc2
+        indchildcopy(1+(i-1)*np:i*np,dir) = indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d_before
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_copy1d_after
+!
+!> Carries out a copy on a parent grid (vector x) from its child grid (vector y)
+!! using precomputed index.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_copy1d_after ( x, y, np, nc, dir )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x            !< Coarse output data to parent
+    real, dimension(nc), intent(in)     :: y            !< Fine input data from child
+    integer,             intent(in)     :: np           !< Length of parent array
+    integer,             intent(in)     :: nc           !< Length of child  array
+    integer,             intent(in)     :: dir          !< Direction
+!---------------------------------------------------------------------------------------------------
+    integer :: i
+!
+!CDIR ALTCODE
+    do i = 1,np
+        x(i) = y(indchildcopy(i,dir))
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_copy1d_after
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_average1d
+!
+!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_average1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(out)    :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np,nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+!
+    INTEGER :: i, ii, locind_child_left, coeffraf
+    REAL    :: xpos, invcoeffraf
+    INTEGER :: nbnonnuls
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    if (coeffraf == 1) then
+        locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = 0.
+!
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+        do i = 1,np
+            nbnonnuls = 0
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+!                    nbnonnuls = nbnonnuls + 1
+                    x(i) = x(i) + y(ii)
+                ENDIF
+            enddo
+!            IF (nbnonnuls /= 0) THEN
+!                x(i) = x(i)/nbnonnuls
+!            ELSE
+!                x(i) = Agrif_SpecialValueFineGrid
+!            ENDIF
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+    ELSE
+!
+!CDIR ALTCODE
+        do i = 1,np
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                x(i) = x(i) + y(ii)
+            enddo
+!            x(i) = x(i)*invcoeffraf
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+        IF (.not.Agrif_Update_Weights) THEN
+           x = x * invcoeffraf
+        ENDIF
+    ENDIF
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_average1d
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Average1dPrecompute
+!
+!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Average1dPrecompute ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: nc2, np, nc
+    REAL,    intent(in) :: s_parent,  s_child
+    REAL,    intent(in) :: ds_parent, ds_child
+    INTEGER, intent(in) :: dir
+!
+    INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp
+    INTEGER :: i, locind_child_left, coeffraf
+    REAL    :: xpos
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    xpos = s_parent
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    if (.not.allocated(indchildaverage)) then
+        allocate(indchildaverage(np*nc2,3))
+    else
+        if (size(indchildaverage,1)<np*nc2) then
+            allocate( indchildaverage_tmp(size(indchildaverage,1),size(indchildaverage,2)))
+            indchildaverage_tmp = indchildaverage
+            deallocate(indchildaverage)
+            allocate(indchildaverage(np*nc2,3))
+            indchildaverage(1:size(indchildaverage_tmp,1),1:size(indchildaverage_tmp,2)) = indchildaverage_tmp
+            deallocate(indchildaverage_tmp)
+        endif
+    endif
+!
+    do i = 1,np
+        indchildaverage(i,dir)= -coeffraf/2+locind_child_left+diffmod
+        locind_child_left = locind_child_left + coeffraf
+    enddo
+!
+    do i = 2,nc2
+        indchildaverage(1+(i-1)*np:i*np,dir) = indchildaverage(1+(i-2)*np:(i-1)*np,dir) + nc
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Average1dPrecompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Average1dAfterCompute
+!
+!> Carries out an update by average on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Average1dAfterCompute ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child, dir )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(inout)  :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np, nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+    INTEGER,             intent(in)     :: dir
+!
+    REAL    :: invcoeffraf
+    INTEGER :: i, j, coeffraf
+    INTEGER, DIMENSION(np) :: nbnonnuls
+    REAL, DIMENSION(0:7), parameter :: invcoeff = (/1.,1.,0.5,1./3.,0.25,0.2,1./6.,1./7./)
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+!
+!        nbnonnuls = 0
+        do  j = 1,coeffraf
+            do i = 1,np
+                IF (y(indchildaverage(i,dir) + j -1) /= Agrif_SpecialValueFineGrid) THEN
+!                    nbnonnuls(i) = nbnonnuls(i) + 1
+                    x(i) = x(i) +  y(indchildaverage(i,dir) + j-1 )
+                ENDIF
+            enddo
+        enddo
+        do i=1,np
+  !          x(i) = x(i)*invcoeff(nbnonnuls(i))
+  !          if (nbnonnuls(i) == 0) x(i) = Agrif_SpecialValueFineGrid
+        enddo
+!
+    ELSE
+!
+!CDIR NOLOOPCHG
+        do  j = 1,coeffraf
+!CDIR VECTOR
+            do i= 1,np
+                x(i) = x(i) + y(indchildaverage(i,dir) + j-1 )
+            enddo
+        enddo
+        IF (.not.Agrif_Update_Weights) THEN
+           x = x * invcoeffraf
+        ENDIF
+!
+    ENDIF
+
+!---------------------------------------------------------------------------------------------------
+end subroutine Average1dAfterCompute
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_basicupdate_full_weighting1D
+!
+!> Carries out an update by full_weighting on a parent grid (vector x) from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_full_weighting1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    real, dimension(np), intent(out)    :: x
+    real, dimension(nc), intent(in)     :: y
+    integer,             intent(in)     :: np, nc
+    real,                intent(in)     :: s_parent,  s_child
+    real,                intent(in)     :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    REAL    :: xpos, xposfin
+    INTEGER :: i, ii, diffmod
+    INTEGER :: it1, it2
+    INTEGER :: i1,  i2
+    INTEGER :: coeffraf
+    INTEGER :: locind_child_left
+    REAL    :: sumweight, invsumweight
+    REAL    :: weights(-Agrif_MaxRaff:Agrif_MaxRaff)
+
+    coeffraf = nint(ds_parent/ds_child)
+    locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
+!
+    if (coeffraf == 1) then
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = 0.
+!
+    xposfin = s_child + ds_child * (locind_child_left - 1)
+    IF (abs(xposfin - xpos) < 0.001) THEN
+        diffmod = 0
+    ELSE
+        diffmod = 1
+    ENDIF
+!
+    if (diffmod == 1) THEN
+        invsumweight=1./(2.*coeffraf**2)
+        do i = -coeffraf,-1
+            weights(i) = invsumweight*(2*(coeffraf+i)+1)
+        enddo
+        do i = 0,coeffraf-1
+            weights(i) = weights(-(i+1))
+        enddo
+        it1 = -coeffraf
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 1
+        
+    else
+        invsumweight=1./coeffraf**2
+        do i = -(coeffraf-1),0
+            weights(i) = invsumweight*(coeffraf + i)
+        enddo
+        do i=1,coeffraf-1
+            weights(i) = invsumweight*(coeffraf - i)
+        enddo
+        it1 = -(coeffraf-1)
+        i1 = -(coeffraf-1)+locind_child_left
+        i2 = 2*coeffraf - 2
+
+    endif
+!
+    sumweight = 0.
+    MYLOOP : do i = 1,np
+!
+        it2 = it1
+
+!    sumweight = 0.
+    
+        do ii = i1,i1+i2
+!
+            IF (Agrif_UseSpecialValueInUpdate) THEN
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+                    x(i) = x(i) + weights(it2)*y(ii)
+!                    sumweight = sumweight+weights(it2)
+                ELSE
+                    x(i) = Agrif_SpecialValueFineGrid
+                    i1=i1+coeffraf
+                    CYCLE MYLOOP
+                ENDIF
+            ELSE
+                x(i) = x(i) + weights(it2)*y(ii)
+            ENDIF
+
+            it2 = it2+1
+!
+        enddo
+!
+        i1 = i1 + coeffraf
+!
+        enddo MYLOOP
+        
+        IF (Agrif_UseSpecialValueInUpdate) THEN
+          x = x * coeffraf ! x will be divided by coeffraf later in modupdate.F90
+        ENDIF
+        
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_full_weighting1D
+!===================================================================================================
+!
+end module Agrif_UpdateBasic
Index: vendors/AGRIF/AGRIF_FILES/modutil.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modutil.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modutil.F90	(revision 9621)
@@ -0,0 +1,1108 @@
+!
+! $Id$
+!
+!     Agrif (Adaptive Grid Refinement In Fortran)
+!
+!     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
+!                        Christophe Vouland (Christophe.Vouland@imag.fr)
+!
+!     This program is free software; you can redistribute it and/or modify
+!     it under the terms of the GNU General Public License as published by
+!     the Free Software Foundation; either version 2 of the License, or
+!     (at your option) any later version.
+!
+!     This program is distributed in the hope that it will be useful,
+!     but WITHOUT ANY WARRANTY; without even the implied warranty of
+!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+!     GNU General Public License for more details.
+!
+!     You should have received a copy of the GNU General Public License
+!     along with this program; if not, write to the Free Software
+!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!
+!> Module Agrif_Util
+!!
+!! This module contains the two procedures called in the main program :
+!! - #Agrif_Init_Grids allows the initialization of the root coarse grid
+!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration.
+!
+module Agrif_Util
+!
+    use Agrif_Clustering
+    use Agrif_BcFunction
+    use Agrif_seq
+!
+    implicit none
+!
+    abstract interface
+        subroutine step_proc()
+        end subroutine step_proc
+    end interface
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Step
+!
+!> Creates the grid hierarchy and manages the time integration procedure.
+!> It is called in the main program.
+!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+    type(agrif_grid), pointer :: ref_grid
+!
+! Set the clustering variables
+    call Agrif_clustering_def()
+!
+! Creation and initialization of the grid hierarchy
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+!
+        if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then
+            call Agrif_Regrid()
+            Agrif_regrid_has_been_done = .TRUE.
+        endif
+!
+    else
+!
+        if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then
+            call Agrif_Regrid()
+        endif
+!
+    endif
+!
+! Time integration of the grid hierarchy
+    if (agrif_coarse) then
+      ref_grid => agrif_coarsegrid
+    else
+      ref_grid => agrif_mygrid
+    endif
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Integrate_Parallel(ref_grid,procname)
+    else
+        call Agrif_Integrate(ref_grid,procname)
+    endif
+!
+    if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Child
+!
+!> Apply 'procname' to each grid of the hierarchy
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_Child ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+!
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname)
+    else
+        call Agrif_Integrate_Child(Agrif_Mygrid,procname)
+    endif
+!
+    if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Regrid
+!
+!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Regrid ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(init_proc), optional    :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
+!
+    type(Agrif_Rectangle), pointer     :: coarsegrid_fixed
+    type(Agrif_Rectangle), pointer     :: coarsegrid_moving
+    integer                            :: i, j
+    integer :: nunit
+    logical :: BEXIST
+    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
+    integer :: is_coarse, rhox, rhoy, rhoz, rhot
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
+        call Agrif_detect_all(Agrif_Mygrid)     ! Detection of areas to be refined
+!
+    allocate(coarsegrid_fixed)
+    allocate(coarsegrid_moving)
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
+        call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
+!
+    if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
+!
+        if (Agrif_Mygrid % ngridstep == 0) then
+!            
+            nunit = Agrif_Get_Unit()
+            open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99)
+            if (agrif_coarse) then ! SKIP the coarse grid declaration
+                if (Agrif_Probdim == 3) then
+                    read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
+                elseif (Agrif_Probdim == 2) then
+                    read(nunit,*) is_coarse, rhox, rhoy, rhot
+                elseif (Agrif_Probdim == 2) then
+                    read(nunit,*) is_coarse, rhox, rhot
+                endif
+            endif
+!           Creation of the grid hierarchy from the Agrif_FixedGrids.in file
+            do i = 1,Agrif_Probdim
+                coarsegrid_fixed % imin(i) = 1
+                coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1
+            enddo
+            j = 1
+            call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit)
+            close(nunit)
+!
+            call Agrif_gl_clear(Agrif_oldmygrid)
+!
+!           Creation of the grid hierarchy from coarsegrid_fixed
+            call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed)
+            
+        else
+            call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
+        endif
+    else
+        call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
+        call Agrif_gl_clear(Agrif_Mygrid % child_list)
+    endif
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
+!
+        call Agrif_Save_All(Agrif_oldmygrid)
+        call Agrif_Free_before_All(Agrif_oldmygrid)
+!
+!       Creation of the grid hierarchy from coarsegrid_moving
+        call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving)
+!
+    endif
+!
+!   Initialization of the grid hierarchy by copy or interpolation
+!
+#if defined AGRIF_MPI
+    if ( Agrif_Parallel_sisters ) then
+        call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid)
+        call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname)
+    else
+        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
+    endif
+#else
+        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
+#endif
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid)
+!
+    Agrif_regrid_has_been_done = .TRUE.
+!
+    call Agrif_Instance( Agrif_Mygrid )
+!
+    deallocate(coarsegrid_fixed)
+    deallocate(coarsegrid_moving)
+!
+    return
+!
+!     Opening error
+!
+99  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+    if (.not. BEXIST) then
+        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+        STOP
+    else
+        print*,'Error opening file AGRIF_FixedGrids.in'
+        STOP
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Regrid
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_detect_All
+!
+!> Detects areas to be refined.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_detect_all ( g )
+!---------------------------------------------------------------------------------------------------
+    TYPE(Agrif_Grid),  pointer  :: g        !< Pointer on the current grid
+!
+    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer, DIMENSION(3)       :: size
+    integer                     :: i
+    real                        :: g_eps
+!
+    parcours => g % child_list % first
+!
+!   To be positioned on the finer grids of the grid hierarchy
+!
+    do while (associated(parcours))
+        call Agrif_detect_all(parcours % gr)
+        parcours => parcours % next
+    enddo
+!
+    g_eps = huge(1.)
+    do i = 1,Agrif_Probdim
+        g_eps = min(g_eps, g % Agrif_dx(i))
+    enddo
+!
+    g_eps = g_eps / 100.
+!
+    if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0
+    if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0
+    if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0
+!
+    do i = 1,Agrif_Probdim
+        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return
+    enddo
+!
+    call Agrif_instance(g)
+!
+!   Detection (Agrif_detect is a users routine)
+!
+    do i = 1,Agrif_Probdim
+        size(i) = g % nb(i) + 1
+    enddo
+!
+    SELECT CASE (Agrif_Probdim)
+    CASE (1)
+        call Agrif_detect(g%tabpoint1D,size)
+    CASE (2)
+        call Agrif_detect(g%tabpoint2D,size)
+    CASE (3)
+        call Agrif_detect(g%tabpoint3D,size)
+    END SELECT
+!
+!   Addition of the areas detected on the child grids
+!
+    parcours => g % child_list % first
+!
+    do while (associated(parcours))
+        call Agrif_Add_detected_areas(g,parcours % gr)
+        parcours => parcours % next
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_detect_all
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Add_detected_areas
+!
+!> Adds on the parent grid the areas detected on its child grids
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Add_detected_areas ( parentgrid, childgrid )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid), pointer   :: parentgrid
+    Type(Agrif_Grid), pointer   :: childgrid
+!
+    integer :: i,j,k
+!
+    do i = 1,childgrid%nb(1)+1
+        if ( Agrif_Probdim == 1 ) then
+            if (childgrid%tabpoint1D(i)==1) then
+                parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1
+            endif
+        else
+            do j=1,childgrid%nb(2)+1
+                if (Agrif_Probdim==2) then
+                    if (childgrid%tabpoint2D(i,j)==1) then
+                        parentgrid%tabpoint2D(                       &
+                            childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
+                            childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
+                    endif
+                else
+                    do k=1,childgrid%nb(3)+1
+                        if (childgrid%tabpoint3D(i,j,k)==1) then
+                            parentgrid%tabpoint3D(                       &
+                                childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
+                                childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), &
+                                childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
+                        endif
+                    enddo
+                endif
+            enddo
+        endif
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Add_detected_areas
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_before_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_before_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
+!
+    Type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
+!
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if (.not. parcours%gr%fixed) then
+            call Agrif_Free_data_before(parcours%gr)
+            parcours % gr % oldgrid = .TRUE.
+        endif
+!
+        call Agrif_Free_before_all (parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_before_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Save_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Save_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
+!
+    type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
+!
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if (.not. parcours%gr%fixed) then
+            call Agrif_Instance(parcours%gr)
+            call Agrif_Before_Regridding()
+            parcours % gr % oldgrid = .TRUE.
+        endif
+!
+        call Agrif_Save_All(parcours % gr % child_list)
+!
+        parcours => parcours % next
+!
+      enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Save_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Free_after_All
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Free_after_All ( gridlist )
+!---------------------------------------------------------------------------------------------------
+    Type(Agrif_Grid_List), intent(inout)    :: gridlist       !< Grid list to free
+!
+    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive proced
+    Type(Agrif_PGrid), pointer  :: preparcours
+    Type(Agrif_PGrid), pointer  :: preparcoursini
+!
+    allocate(preparcours)
+!
+    preparcoursini => preparcours
+!
+    nullify(preparcours % gr)
+!
+    preparcours % next => gridlist % first
+    parcours => gridlist % first
+!
+    do while (associated(parcours))
+!
+        if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then
+            call Agrif_Free_data_after(parcours%gr)
+        endif
+!
+        call Agrif_Free_after_all( parcours%gr % child_list )
+!
+        if (parcours % gr % oldgrid) then
+            deallocate(parcours % gr)
+            preparcours % next => parcours % next
+            deallocate(parcours)
+            parcours => preparcours % next
+        else
+            preparcours => preparcours % next
+            parcours => parcours % next
+        endif
+!
+    enddo
+!
+    deallocate(preparcoursini)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Free_after_All
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k
+!
+!   Instanciation of the variables of the current grid
+!    if ( g % fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+!    endif
+!
+!   One step on the current grid
+!
+    call procname ()
+!
+!   Number of time steps on the current grid
+!
+    g%ngridstep = g % ngridstep + 1
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call Agrif_Integrate(parcours % gr, procname)
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Parallel
+!
+!> Manages the time integration of the grid hierarchy in parallel
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Parallel ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+#if defined AGRIF_MPI
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k, is
+!
+!   Instanciation of the variables of the current grid
+    if ( g % fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+    endif
+!
+! One step on the current grid
+    call procname ()
+!
+! Number of time steps on the current grid
+    g % ngridstep = g % ngridstep + 1
+!
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(g,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(gridp % gr)
+!
+!     Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, gridp % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call Agrif_Integrate_Parallel(gridp % gr, procname)
+        enddo
+!
+    enddo
+#else
+    call Agrif_Integrate( g, procname )
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Parallel
+!===================================================================================================
+!
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_ChildGrids
+!
+!> Manages the time integration of the grid hierarchy.
+!! Call the subroutine procname on each child grid of the current grid
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_ChildGrids ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+    integer                     :: nbt      ! Number of time steps of the current grid
+    integer                     :: i, k, is
+    type(Agrif_Grid)                    , pointer :: save_grid
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    
+    save_grid => Agrif_Curgrid
+
+! Number of time steps on the current grid
+    save_grid % ngridstep = save_grid % ngridstep + 1
+    
+#ifdef AGRIF_MPI
+    if ( .not. Agrif_Parallel_sisters ) then
+#endif
+    parcours => save_grid % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call procname()
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+
+#ifdef AGRIF_MPI
+    else
+#endif    
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(save_grid % child_seq) ) return
+!
+    do is = 1, save_grid % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(save_grid,is)
+!
+!     Instanciation of the variables of the current grid
+        call Agrif_Instance(gridp % gr)
+!
+!     Number of time steps
+        nbt = 1
+        do i = 1,Agrif_Probdim
+            nbt = max(nbt, gridp % gr % timeref(i))
+        enddo
+!
+        do k = 1,nbt
+            call procname()
+        enddo
+!
+    enddo
+#ifdef AGRIF_MPI
+    endif
+#endif 
+
+    call Agrif_Instance(save_grid)
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_ChildGrids
+!===================================================================================================
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
+!
+!   One step on the current grid
+!
+    call procname ()
+!
+!   Number of time steps on the current grid
+!
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+        call Agrif_Integrate_Child (parcours % gr, procname)
+        parcours => parcours % next
+!
+    enddo
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child_Parallel
+!
+!> Manages the time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+#if defined AGRIF_MPI
+    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
+    integer                     :: is
+!
+! Instanciation of the variables of the current grid
+    call Agrif_Instance(g)
+!
+! One step on the current grid
+    call procname ()
+!
+! Continue only if the grid has defined sequences of child integrations.
+    if ( .not. associated(g % child_seq) ) return
+!
+    do is = 1, g % child_seq % nb_seqs
+!
+!     For each sequence, a given processor does integrate only on grid.
+        gridp => Agrif_seq_select_child(g,is)
+        call Agrif_Integrate_Child_Parallel(gridp % gr, procname)
+!
+    enddo
+!
+    call Agrif_Instance(g)
+#else
+    call Agrif_Integrate_Child( g, procname )
+#endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child_Parallel
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Init_Grids
+!
+!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Init_Grids ( procname1, procname2 )
+!---------------------------------------------------------------------------------------------------
+    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
+    procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls)
+!
+    integer :: i, ierr_allocate, nunit
+    integer :: is_coarse, rhox,rhoy,rhoz,rhot
+    logical :: BEXIST
+!
+    if (present(procname1)) Then
+        call procname1()
+    else
+        call Agrif_probdim_modtype_def()
+    endif
+!
+
+! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in
+    nunit = Agrif_Get_Unit()
+    open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98)
+    if (Agrif_Probdim == 3) then
+       read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
+    elseif (Agrif_Probdim == 2) then
+       read(nunit,*) is_coarse, rhox, rhoy, rhot
+    elseif (Agrif_Probdim == 2) then
+       read(nunit,*) is_coarse, rhox, rhot
+    endif
+    if (is_coarse == -1) then
+       agrif_coarse = .TRUE.
+       if (Agrif_Probdim == 3) then
+          coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)
+       elseif (Agrif_Probdim == 2) then
+          coarse_spaceref(1:2)=(/rhox,rhoy/)
+       elseif (Agrif_Probdim == 2) then
+          coarse_spaceref(1:1)=(/rhox/)
+       endif
+       coarse_timeref(1:Agrif_Probdim) = rhot
+    endif
+    close(nunit)
+    
+    Agrif_UseSpecialValue = .FALSE.
+    Agrif_UseSpecialValueFineGrid = .FALSE.
+    Agrif_SpecialValue = 0.
+    Agrif_SpecialValueFineGrid = 0.
+!
+    allocate(Agrif_Mygrid)
+    allocate(Agrif_OldMygrid)
+!
+!   Space and time refinement factors are set to 1 on the root grid
+!
+    do i = 1,Agrif_Probdim
+        Agrif_Mygrid % spaceref(i) = coarse_spaceref(i)
+        Agrif_Mygrid % timeref(i)  = coarse_timeref(i)
+    enddo
+!
+!   Initialization of the number of time steps
+    Agrif_Mygrid % ngridstep = 0
+    Agrif_Mygrid % grid_id   = 0
+!
+!   No parent grid for the root coarse grid
+    nullify(Agrif_Mygrid % parent)
+!
+!   Initialization of the minimum positions, global abscissa and space steps
+    do i = 1, Agrif_Probdim
+        Agrif_Mygrid % ix(i) = 1
+        Agrif_Mygrid % Agrif_x(i)  = 0.
+        Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i)
+        Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i)
+!       Borders of the root coarse grid
+        Agrif_Mygrid % NearRootBorder(i) = .true.
+        Agrif_Mygrid % DistantRootBorder(i) = .true.
+    enddo
+!
+!   The root coarse grid is a fixed grid
+    Agrif_Mygrid % fixed = .TRUE.
+!   Level of the root grid
+    Agrif_Mygrid % level = 0
+!   Maximum level in the hierarchy
+    Agrif_MaxLevelLoc = 0
+!
+!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+    Agrif_Mygrid % rank = 1
+!
+!   Number of the root grid as a fixed grid
+    Agrif_Mygrid % fixedrank = 0
+!
+!   Initialization of some fields of the root grid variables
+    ierr_allocate = 0
+    if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate)
+    if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate)
+    if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate)
+    if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate)
+    if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate)
+    if (ierr_allocate /= 0) THEN
+      STOP "*** ERROR WHEN ALLOCATING TABVARS ***"
+    endif
+!
+!   Initialization of the other fields of the root grid variables (number of
+!   cells, positions, number and type of its dimensions, ...)
+    call Agrif_Instance(Agrif_Mygrid)
+    call Agrif_Set_numberofcells(Agrif_Mygrid)
+!
+!   Allocation of the array containing the values of the grid variables
+    call Agrif_Allocation(Agrif_Mygrid, procname2)
+    call Agrif_initialisations(Agrif_Mygrid)
+!
+!   Total number of fixed grids
+    Agrif_nbfixedgrids = 0
+    
+! If a grand mother grid is declared
+
+    if (agrif_coarse) then
+      allocate(Agrif_Coarsegrid)
+
+      Agrif_Coarsegrid % ngridstep = 0
+      Agrif_Coarsegrid % grid_id   = -9999
+      
+    do i = 1, Agrif_Probdim
+        Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i)
+        Agrif_Coarsegrid%timeref(i) = coarse_timeref(i)
+        Agrif_Coarsegrid % ix(i) = 1
+        Agrif_Coarsegrid % Agrif_x(i)  = 0.
+        Agrif_Coarsegrid % Agrif_dx(i) = 1.
+        Agrif_Coarsegrid % Agrif_dt(i) = 1.
+!       Borders of the root coarse grid
+        Agrif_Coarsegrid % NearRootBorder(i) = .true.
+        Agrif_Coarsegrid % DistantRootBorder(i) = .true.
+        Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i)
+    enddo      
+
+!   The root coarse grid is a fixed grid
+    Agrif_Coarsegrid % fixed = .TRUE.
+!   Level of the root grid
+    Agrif_Coarsegrid % level = -1
+    
+    Agrif_Coarsegrid % grand_mother_grid = .true.
+
+!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
+    Agrif_Coarsegrid % rank = -9999
+!
+!   Number of the root grid as a fixed grid
+    Agrif_Coarsegrid % fixedrank = -9999
+    
+      Agrif_Mygrid%parent => Agrif_Coarsegrid
+      
+! Not used but required to prevent seg fault
+      Agrif_Coarsegrid%parent => Agrif_Mygrid
+      
+      call Agrif_Create_Var(Agrif_Coarsegrid)
+
+! Reset to null
+      Nullify(Agrif_Coarsegrid%parent)
+      
+      Agrif_Coarsegrid%child_list%nitems = 1
+      allocate(Agrif_Coarsegrid%child_list%first)
+      allocate(Agrif_Coarsegrid%child_list%last)
+      Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid
+      Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid
+
+    endif
+    
+    return
+
+98  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
+    if (.not. BEXIST) then
+        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
+        STOP
+    else
+        print*,'Error opening file AGRIF_FixedGrids.in'
+        STOP
+    endif
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Init_Grids
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Deallocation
+!
+!> Deallocates all data arrays.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Deallocation
+!---------------------------------------------------------------------------------------------------
+    integer                         :: nb
+    type(Agrif_Variable), pointer   :: var
+    type(Agrif_Variable_c), pointer   :: var_c
+    type(Agrif_Variable_l), pointer   :: var_l
+    type(Agrif_Variable_i), pointer   :: var_i
+!
+    do nb = 1,Agrif_NbVariables(0)
+!
+        var => Agrif_Mygrid % tabvars(nb)
+!
+        if ( allocated(var % array1) ) deallocate(var % array1)
+        if ( allocated(var % array2) ) deallocate(var % array2)
+        if ( allocated(var % array3) ) deallocate(var % array3)
+        if ( allocated(var % array4) ) deallocate(var % array4)
+        if ( allocated(var % array5) ) deallocate(var % array5)
+        if ( allocated(var % array6) ) deallocate(var % array6)
+!
+        if ( allocated(var % sarray1) ) deallocate(var % sarray1)
+        if ( allocated(var % sarray2) ) deallocate(var % sarray2)
+        if ( allocated(var % sarray3) ) deallocate(var % sarray3)
+        if ( allocated(var % sarray4) ) deallocate(var % sarray4)
+        if ( allocated(var % sarray5) ) deallocate(var % sarray5)
+        if ( allocated(var % sarray6) ) deallocate(var % sarray6)
+!
+        if ( allocated(var % darray1) ) deallocate(var % darray1)
+        if ( allocated(var % darray2) ) deallocate(var % darray2)
+        if ( allocated(var % darray3) ) deallocate(var % darray3)
+        if ( allocated(var % darray4) ) deallocate(var % darray4)
+        if ( allocated(var % darray5) ) deallocate(var % darray5)
+        if ( allocated(var % darray6) ) deallocate(var % darray6)
+!
+    enddo
+!
+    do nb = 1,Agrif_NbVariables(1)
+!
+        var_c => Agrif_Mygrid % tabvars_c(nb)
+!
+        if ( allocated(var_c % carray1) ) deallocate(var_c % carray1)
+        if ( allocated(var_c % carray2) ) deallocate(var_c % carray2)
+!
+    enddo
+
+    do nb = 1,Agrif_NbVariables(3)
+!
+        var_l => Agrif_Mygrid % tabvars_l(nb)
+!
+        if ( allocated(var_l % larray1) ) deallocate(var_l % larray1)
+        if ( allocated(var_l % larray2) ) deallocate(var_l % larray2)
+        if ( allocated(var_l % larray3) ) deallocate(var_l % larray3)
+        if ( allocated(var_l % larray4) ) deallocate(var_l % larray4)
+        if ( allocated(var_l % larray5) ) deallocate(var_l % larray5)
+        if ( allocated(var_l % larray6) ) deallocate(var_l % larray6)
+!
+    enddo
+!
+    do nb = 1,Agrif_NbVariables(4)
+!
+        var_i => Agrif_Mygrid % tabvars_i(nb)
+!
+        if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1)
+        if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2)
+        if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3)
+        if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4)
+        if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5)
+        if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)
+!
+    enddo
+!
+    if ( allocated(Agrif_Mygrid % tabvars) )   deallocate(Agrif_Mygrid % tabvars)
+    if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c)
+    if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r)
+    if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l)
+    if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i)
+    deallocate(Agrif_Mygrid)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Deallocation
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_adj
+!
+!> creates the grid hierarchy and manages the backward time integration procedure.
+!> It is called in the main program.
+!> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_adj ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)    :: procname     !< Subroutine to call on each grid
+!
+!   Creation and initialization of the grid hierarchy
+!
+!   Set the clustering variables
+    call Agrif_clustering_def()
+!
+    if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
+!
+        if (Agrif_Mygrid % ngridstep == 0) then
+            if (.not.Agrif_regrid_has_been_done ) then
+                call Agrif_Regrid()
+            endif
+            call Agrif_Instance(Agrif_Mygrid)
+        endif
+!
+    else
+!
+        if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
+            call Agrif_Regrid()
+            call Agrif_Instance(Agrif_Mygrid)
+        endif
+!
+    endif
+!
+!   Time integration of the grid hierarchy
+!
+    call Agrif_Integrate_adj (Agrif_Mygrid,procname)
+!
+    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Step_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_adj
+!
+!> Manages the backward time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_adj ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure
+    integer                    :: nbt      ! Number of time steps of the current grid
+    integer                    :: k
+!
+!   Instanciation of the variables of the current grid
+    if ( g%fixedrank /= 0 ) then
+        call Agrif_Instance(g)
+    endif
+!
+!   Number of time steps on the current grid
+!
+    g%ngridstep = g % ngridstep + 1
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!   Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+!
+!       Number of time steps
+        nbt = 1
+        do k = 1,Agrif_Probdim
+            nbt = max(nbt, parcours % gr % timeref(k))
+        enddo
+!
+        do k = nbt,1,-1
+            call Agrif_Integrate_adj(parcours % gr, procname)
+        enddo
+!
+        parcours => parcours % next
+!
+    enddo
+!
+    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
+!
+!   One step on the current grid
+    call procname ()
+!
+end subroutine Agrif_Integrate_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Child_adj
+!
+!> Apply 'procname' to each grid of the hierarchy from Child to Parent
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Step_Child_adj ( procname )
+!---------------------------------------------------------------------------------------------------
+    procedure(step_proc)        :: procname !< Subroutine to call on each grid
+!
+    call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname)
+!
+    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
+!
+end subroutine Agrif_Step_Child_adj
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Integrate_Child_adj
+!
+!> Manages the backward time integration of the grid hierarchy.
+!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj.
+!---------------------------------------------------------------------------------------------------
+recursive subroutine Agrif_Integrate_Child_adj ( g, procname )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid),pointer   :: g          !< Pointer on the current grid
+    procedure(step_proc)       :: procname   !< Subroutine to call on each grid
+!
+    type(Agrif_PGrid),pointer  :: parcours   !< Pointer for the recursive procedure
+!
+    parcours => g % child_list % first
+!
+!   Recursive procedure for the time integration of the grid hierarchy
+    do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        call Agrif_Instance(parcours % gr)
+        call Agrif_Integrate_Child_adj(parcours % gr, procname)
+!
+       parcours => parcours % next
+!
+    enddo
+    if ( g % child_list % nitems > 0 )  call Agrif_Instance(g)
+!
+!   One step on the current grid
+    call procname()
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Integrate_Child_adj
+!===================================================================================================
+!
+!===================================================================================================
+
+end module Agrif_Util
Index: vendors/AGRIF/AGRIF_FILES/modvariables.F90
===================================================================
--- vendors/AGRIF/AGRIF_FILES/modvariables.F90	(revision 9621)
+++ vendors/AGRIF/AGRIF_FILES/modvariables.F90	(revision 9621)
@@ -0,0 +1,146 @@
+module Agrif_Variables
+!
+    use Agrif_CurgridFunctions
+!
+    implicit none
+!
+contains
+!
+!===================================================================================================
+!  subroutine Agrif_Declare_Variable
+!
+!> Declare a new variable profile
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Declare_Variable ( posvar, firstpoint, raf, lb, ub, varid, torestore )
+!---------------------------------------------------------------------------------------------------
+    integer,      dimension(:), intent(in)  :: posvar     !< position of the variable on the cell
+                                                          !! (1 for the border of the edge, 2 for the center)
+    integer,      dimension(:), intent(in)  :: firstpoint !< index of the first point in the real domain
+    character(1), dimension(:), intent(in)  :: raf        !< Array indicating the type of dimension (space or not)
+                                                          !!   for each of them
+    integer,      dimension(:), intent(in)  :: lb         !< Lower bounds of the array
+    integer,      dimension(:), intent(in)  :: ub         !< Upper bounds of the array
+    integer,                    intent(out) :: varid      !< Id number of the newly created variable
+    logical,      optional,     intent(in)  :: torestore  !< Indicates if the array restore is used
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variables_List), pointer :: new_varlist
+    type(Agrif_Variable),       pointer :: var
+    integer                             :: nbdim, i
+    logical                             :: restore
+
+    restore = .FALSE.
+    if ( Agrif_Mygrid % ngridstep /= 0 ) then
+        if (present(torestore)) restore = torestore
+    endif
+!
+    nbdim = SIZE(posvar)
+!
+    allocate(new_varlist)
+    allocate(new_varlist % var)
+
+    var => new_varlist % var
+
+    allocate(var % posvar(nbdim))
+    allocate(var % interptab(nbdim))
+    allocate(var % coords(nbdim))
+!
+    var % nbdim          = nbdim
+    var % interptab      = raf(1:nbdim)
+    var % posvar         = posvar(1:nbdim)
+    var % point(1:nbdim) = firstpoint(1:nbdim)
+    var % restore = restore
+!
+    do i = 1,nbdim
+        select case( raf(i) )
+            case('x')    ; var % coords(i) = 1
+            case('y')    ; var % coords(i) = 2
+            case('z')    ; var % coords(i) = 3
+            case('N')    ; var % coords(i) = 0
+            case default ; var % coords(i) = 0
+        end select
+    enddo
+!
+    var % lb(1:nbdim) = lb(1:nbdim)
+    var % ub(1:nbdim) = ub(1:nbdim)
+
+    if ( restore ) then
+        select case(nbdim)
+        case(1)
+            allocate(var % Restore1D(lb(1):ub(1)))
+            var % Restore1D = 0
+        case(2)
+            allocate(var % Restore2D(lb(1):ub(1),   &
+                                     lb(2):ub(2)))
+            var % Restore2D = 0
+        case(3)
+            allocate(var % Restore3D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3)))
+            var % Restore3D = 0
+        case(4)
+            allocate(var % Restore4D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3),   &
+                                     lb(4):ub(4)))
+            var % Restore4D = 0
+        case(5)
+            allocate(var % Restore5D(lb(1):ub(1),   &
+                                     lb(2):ub(2),   &
+                                     lb(3):ub(3),   &
+                                     lb(4):ub(4),   &
+                                     lb(5):ub(5)))
+            var % Restore5D = 0
+        end select
+    endif
+
+    new_varlist % next => Agrif_Curgrid % variables
+
+    Agrif_Curgrid % variables => new_varlist
+    Agrif_Curgrid % Nbvariables = Agrif_Curgrid % Nbvariables + 1
+
+    varid = -Agrif_Curgrid % Nbvariables
+
+    var % parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, Agrif_Curgrid % nbvariables)
+    var % root_var   => Agrif_Search_Variable(Agrif_Mygrid, Agrif_Curgrid % nbvariables)
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Declare_Variable
+!===================================================================================================
+!
+!===================================================================================================
+!  function Agrif_Search_Variable
+!
+!> Returns a pointer to the variable varid for the grid grid.
+!---------------------------------------------------------------------------------------------------
+function Agrif_Search_Variable ( grid, varid ) result(outvar)
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Grid), pointer       :: grid     !< Pointer on the current grid.
+    integer,          intent(in)    :: varid    !< ID number of the variable we are looking for.
+!
+    type(Agrif_Variable),       pointer :: outvar
+    type(Agrif_Variables_List), pointer :: parcours
+    integer :: nb, varidinv
+!
+    if ( .not.associated(grid) ) then
+        outvar => NULL()
+        return
+    endif
+!
+    parcours => grid % variables
+
+    if (.not. associated(parcours)) then   ! can occur on the grand mother grid
+           outvar => NULL()                ! during the first call by agrif_mygrid
+           return
+    endif
+
+    varidinv = 1 + grid % nbvariables - varid
+
+    do nb = 1,varidinv-1
+        parcours => parcours % next
+    enddo
+
+    outvar => parcours % var
+!---------------------------------------------------------------------------------------------------
+end function Agrif_Search_variable
+!===================================================================================================
+!
+end module Agrif_Variables
Index: vendors/AGRIF/LEX/Makefile.lex
===================================================================
--- vendors/AGRIF/LEX/Makefile.lex	(revision 9621)
+++ vendors/AGRIF/LEX/Makefile.lex	(revision 9621)
@@ -0,0 +1,31 @@
+LEX		= flex -i
+YACC	= bison -t -v -g
+
+all: main.c fortran.c
+
+main.c : convert.tab.c convert.yy.c
+	cat   convert.tab.c convert.yy.c > ../LIB/main.c
+	$(RM) convert.tab.c convert.yy.c
+
+fortran.c : fortran.tab.c fortran.yy.c
+	cat   fortran.tab.c fortran.yy.c > ../LIB/fortran.c
+	$(RM) fortran.tab.c fortran.yy.c
+
+convert.tab.c : convert.y decl.h
+	$(YACC) -p convert_ convert.y
+
+fortran.tab.c : fortran.y decl.h
+	$(YACC) -p fortran_ fortran.y
+
+convert.yy.c : convert.lex
+	$(LEX) -P convert_ -o convert.yy.c convert.lex
+
+fortran.yy.c : fortran.lex
+	$(LEX) -P fortran_ -o fortran.yy.c fortran.lex
+
+clean:
+	$(RM) convert.yy.c convert.tab.c convert.output convert.vcg convert.dot	\
+		  fortran.yy.c fortran.tab.c fortran.output fortran.vcg fortran.dot
+
+clean-all: clean
+	$(RM) ../LIB/main.c ../LIB/fortran.c
Index: vendors/AGRIF/LEX/convert.lex
===================================================================
--- vendors/AGRIF/LEX/convert.lex	(revision 9621)
+++ vendors/AGRIF/LEX/convert.lex	(revision 9621)
@@ -0,0 +1,69 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%s character
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define YY_NO_INPUT
+%}
+
+SEPARATEUR      "::"
+COMMENTS        "%".*"%"
+PROBTYPE        "1D"|"2D"|"3D"
+USEITEM         "FIXED_GRIDS"|"ONLY_FIXED_GRIDS"|"F77"
+NAME            [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER         [0-9]+
+NEXTLINE        \n+[ \t]+"$"|\n+[ \t]+"&"
+%%
+parammodule         { return TOK_MODULEMAIN; } /* name of the module                      */
+notgriddep          { return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
+use                 { return TOK_USE; }
+{COMMENTS}          { }
+{SEPARATEUR}        { return TOK_SEP; }
+KIND                { return TOK_KIND; }
+\=                  { return TOK_EQUAL; }
+{USEITEM}           { strcpy(yylval.na,yytext); return TOK_USEITEM;  }
+{PROBTYPE}          { strcpy(yylval.na,yytext); return TOK_PROBTYPE; }  /* dimension of the problem */
+{NAME}              { strcpy(yylval.na,yytext); return TOK_NAME; }
+{INTEGER}           { strcpy(yylval.na,yytext); return TOK_CSTINT; }
+;|\,|\(|\)|:|\[|\]  { return (int) *yytext; }
+\n                  { line_num++; return (int) *yytext; }
+[ \t]+ ;
+%%
Index: vendors/AGRIF/LEX/convert.y
===================================================================
--- vendors/AGRIF/LEX/convert.y	(revision 9621)
+++ vendors/AGRIF/LEX/convert.y	(revision 9621)
@@ -0,0 +1,463 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%{
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+%}
+
+%union {
+    char na[LONG_M];
+}
+
+%token TOK_SEP
+%token TOK_KIND
+%token TOK_EQUAL
+%token TOK_USE
+%token TOK_MODULEMAIN      /* name of the module                              */
+%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
+%token <na> TOK_USEITEM
+%token <na> TOK_NAME
+%token <na> TOK_CSTINT
+%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
+%token ','
+%token ';'
+
+%%
+
+input :
+    | input line ;
+
+line :
+      '\n'
+    | TOK_PROBTYPE TOK_NAME ';'                             { initdimprob(1,$2,"0","0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'                { initdimprob(2,$2, $4,"0"); }
+    | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'   { initdimprob(3,$2, $4, $6); }
+    | TOK_MODULEMAIN TOK_NAME ';'
+        {
+            listofmodules = Addtolistnom($2,listofmodules,0);
+            Addmoduletothelist($2);
+        }
+    | TOK_KIND TOK_NAME TOK_EQUAL TOK_CSTINT ';'
+        {
+            if (!strcasecmp($4,"4"))
+            {
+                listofkind = Addtolistnom($2,listofkind,4);
+            }
+            else if (!strcasecmp($4,"8"))
+            {
+                listofkind = Addtolistnom($2,listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",$4);
+                exit(0);
+            }
+        }
+    | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'
+        {
+            Add_NotGridDepend_Var_1($3);
+        }
+    | TOK_USE TOK_USEITEM ';'
+        {
+            if (!strcasecmp($2,"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp($2,"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        }
+    ;
+%%
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
+
+int main(int argc,char *argv[])
+{
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
+
+/******************************************************************************/
+/*  3-  Parsing of the conv file <name>.in                                    */
+/******************************************************************************/
+
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
Index: vendors/AGRIF/LEX/decl.h
===================================================================
--- vendors/AGRIF/LEX/decl.h	(revision 9621)
+++ vendors/AGRIF/LEX/decl.h	(revision 9621)
@@ -0,0 +1,1 @@
+link ../LIB/decl.h
Index: vendors/AGRIF/LEX/fortran.lex
===================================================================
--- vendors/AGRIF/LEX/fortran.lex	(revision 9621)
+++ vendors/AGRIF/LEX/fortran.lex	(revision 9621)
@@ -0,0 +1,294 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+%option warn
+%option noyywrap
+
+%x parameter
+%s character
+%x donottreat
+%s fortran77style
+%s fortran90style
+%{
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * yyin;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_input = 1;
+int newlinef90 = 0;
+char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+%}
+
+REAL8 "real*8"[ \t]*"(a-h,o-z)"
+
+SLASH       "/"
+DSLASH      "/"[ \t]*"/"
+HEXA        Z\'[0-9a-fA-F]+\'
+NAME        [a-zA-Z\_][a-zA-Z0-9\_]*
+INTEGER     [0-9]+
+
+EXPONENT    [edq][-+]?{INTEGER}
+
+BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*\n
+END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*\n
+
+BEG_INTERFACE   ^[ \t]*interface
+END_INTERFACE   ^[ \t]*end[ \t]*interface.*\n
+
+ASSIGNTYPE      "assignment"[ \t]*"("[ \t]*[-+=]+[ \t]*")"
+
+COMM_F77        ^([Cc*](([ \t]*\n)|([^AaHhOo\n].*\n)))
+COMM_F90        ^[ \t]*!.*\n
+COMM_F90_2      !.*
+NEXTLINEF90     "&".*\n+
+NEXTLINEF77     [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
+
+LABEL           ^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+
+
+%%
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree)  BEGIN(fortran90style) ;
+
+{REAL8}                     { return TOK_REAL8; }
+subroutine                  { return TOK_SUBROUTINE; }
+program                     { return TOK_PROGRAM; }
+allocate                    { inallocate = 1; return TOK_ALLOCATE; }
+nullify			            { return TOK_NULLIFY; }
+null[ ]*\([ ]*\)            { return TOK_NULL_PTR; }
+deallocate                  { inallocate = 1; return TOK_DEALLOCATE; }
+result                      { return TOK_RESULT; }
+function                    { return TOK_FUNCTION; }
+end[ \t]*program            { strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+end[ \t]*module             { strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+end[ \t]*subroutine         { strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+end[ \t]*function           { strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+end                         { strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+include                     { pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+^[ \t]*use[ ]+              { strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+rewind                      { return TOK_REWIND; }
+implicit                    { return TOK_IMPLICIT; }
+none                        { return TOK_NONE; }
+call                        { return TOK_CALL; }
+.true.                      { return TOK_TRUE; }
+.false.                     { return TOK_FALSE; }
+\=\>                        { return TOK_POINT_TO; }
+{ASSIGNTYPE}                { strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+\*\*                        { strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+\.[ \t]*eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; }
+\.[ \t]*eq\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+\.[ \t]*gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  }
+\.[ \t]*ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  }
+\.[ \t]*lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  }
+\.[ \t]*le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  }
+\.[ \t]*neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+\.[ \t]*ne\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  }
+\.[ \t]*not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; }
+\.[ \t]*or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  }
+\.[ \t]*xor\.               { strcpy(yylval.na,fortran_text); return TOK_XOR; }
+\.[ \t]*and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; }
+module                      { return TOK_MODULE; }
+while                       { return TOK_WHILE; }
+concurrent                  { return TOK_CONCURRENT; }
+end[ \t]*do                 { return TOK_ENDDO; }
+do                          { return TOK_PLAINDO;}
+real                        { strcpy(yylval.na,fortran_text); return TOK_REAL; }
+integer                     { strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+logical                     { strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+character                   { strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+{HEXA}                      { strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+double[ \t]*precision       { strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+double[ \t]*complex         { strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+complex                     { return TOK_COMPLEX; }
+allocatable                 { return TOK_ALLOCATABLE; }
+close                       { return TOK_CLOSE; }
+inquire                     { return TOK_INQUIRE; }
+dimension                   { return TOK_DIMENSION; }
+pause                       { return TOK_PAUSE; }
+equivalence                 { return TOK_EQUIVALENCE; }
+stop                        { return TOK_STOP; }
+where                       { return TOK_WHERE; }
+end[ \t]*where              { return TOK_ENDWHERE; }
+else[ \t]*where[ \t]*\(     { return TOK_ELSEWHEREPAR; }
+else[ \t]*where             { return TOK_ELSEWHERE; }
+^[ \t]*contains             { return TOK_CONTAINS; }
+only                        { return TOK_ONLY; }
+parameter                   { return TOK_PARAMETER; }
+recursive                   { return TOK_RECURSIVE; }
+common                      { return TOK_COMMON; }
+^[ \t]*global[ \t]+         { return TOK_GLOBAL; }
+external                    { return TOK_EXTERNAL; }
+intent                      { return TOK_INTENT; }
+pointer                     { return TOK_POINTER; }
+optional                    { return TOK_OPTIONAL; }
+save                        { return TOK_SAVE; }
+^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+^[ \t]*type[ \t\,]+         { return TOK_TYPE; }
+end[ \t]*type               { return TOK_ENDTYPE; }
+stat                        { if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+open                        { return TOK_OPEN; }
+return                      { return TOK_RETURN; }
+exit[^(]                    { return TOK_EXIT; }
+print                       { return TOK_PRINT; }
+module[ \t]*procedure       { return TOK_PROCEDURE; }
+read                        { return TOK_READ; }
+namelist                    { return TOK_NAMELIST; }
+write                       { return TOK_WRITE; }
+flush                       { return TOK_FLUSH; }
+target                      { return TOK_TARGET; }
+public                      { return TOK_PUBLIC; }
+private                     { return TOK_PRIVATE; }
+in                          { strcpy(yylval.na,fortran_text); return TOK_IN; }
+^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+continue                    { return TOK_CONTINUE; }
+go[ \t]*to                  { return TOK_PLAINGOTO; }
+out                         { strcpy(yylval.na,fortran_text); return TOK_OUT; }
+inout                       { strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+intrinsic                   { return TOK_INTRINSIC; }
+then                        { return TOK_THEN; }
+else[ \t]*if                { return TOK_ELSEIF; }
+else                        { return TOK_ELSE; }
+end[ \t]*if                 { return TOK_ENDIF; }
+if                          { return TOK_LOGICALIF; }
+sum[ \t]*\(                 { return TOK_SUM; }
+max[ \t]*\(                 { return TOK_MAX; }
+tanh                        { return TOK_TANH; }
+maxval                      { return TOK_MAXVAL; }
+trim                        { return TOK_TRIM; }
+sqrt\(                      { return TOK_SQRT; }
+select[ \t]*case            { return TOK_SELECTCASE; }
+^[ \t]*case[ \t]*           { return TOK_CASE; }
+default                     { return TOK_DEFAULT; }
+end[ \t]*select             { return TOK_ENDSELECT; }
+file[ \t]*\=                { return TOK_FILE; }
+unit[ \t]*\=                { return TOK_UNIT; }
+fmt[ \t]*\=                 { return TOK_FMT; }
+nml[ \t]*\=                 { return TOK_NML; }
+end[ \t]*\=                 { return TOK_END; }
+eor[ \t]*\=                 { return TOK_EOR; }
+err[ \t]*\=                 { return TOK_ERR; }
+exist[ \t]*\=               { return TOK_EXIST; }
+min[ \t]*\(                 { return TOK_MIN; }
+nint                        { return TOK_NINT; }
+float                       { return TOK_FLOAT; }
+exp                         { return TOK_EXP; }
+cos                         { return TOK_COS; }
+cosh                        { return TOK_COSH; }
+acos                        { return TOK_ACOS; }
+sin                         { return TOK_SIN; }
+sinh                        { return TOK_SINH; }
+asin                        { return TOK_ASIN; }
+log                         { return TOK_LOG; }
+tan                         { return TOK_TAN; }
+atan                        { return TOK_ATAN; }
+cycle                       { return TOK_CYCLE; }
+abs[ \t]*\(                 { return TOK_ABS; }
+mod                         { return TOK_MOD; }
+sign[ \t]*\(                { return TOK_SIGN; }
+minloc                      { return TOK_MINLOC; }
+maxloc                      { return TOK_MAXLOC; }
+minval                      { return TOK_MINVAL; }
+backspace                   { return TOK_BACKSPACE; }
+::                          { return TOK_FOURDOTS;  }
+\({SLASH}                   { return TOK_LEFTAB; }
+{SLASH}\)                   { return TOK_RIGHTAB; }
+format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  {
+                              return TOK_FORMAT; }
+{SLASH}                     { strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+DSLASH                      { strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\') {
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+(\')[^']*(\')             { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+(\")[^"]*(\")             { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+{BEG_INTERFACE}             { BEGIN(donottreat); }
+<donottreat>{END_INTERFACE} { out_of_donottreat(); return '\n'; }
+{NAME}                      { strcpy(yylval.na,fortran_text); return TOK_NAME; }
+({INTEGER}\.[0-9]*)/[^"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+(({INTEGER}\.[0-9]+|[0-9]*\.{INTEGER}){EXPONENT}?)|{INTEGER}(\.)?{EXPONENT}                     {  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+{INTEGER}                   { strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+\$                          {}
+\.                          {}
+\(|\)|:|\[|\]|\+|\-|\*      { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\%                          { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\;                          { return TOK_SEMICOLON; }
+\,                          { return (int) *fortran_text; }
+\=                          { return (int) *fortran_text; }
+\<                          { return (int) *fortran_text; }
+\>                          { return (int) *fortran_text; }
+\n                          { INCREMENT_LINE_NUM() ; return '\n'; }
+^[ ]*$                      {}
+[ \t]+                      {}
+{LABEL}                     { if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+{NEXTLINEF90}               { INCREMENT_LINE_NUM() ; newlinef90=1; }
+{NEXTLINEF77}               { INCREMENT_LINE_NUM() ; }
+
+{BEG_DNT}                   { INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+<donottreat>{END_DNT}       { out_of_donottreat(); return '\n'; }
+<donottreat>.*\n            { INCREMENT_LINE_NUM() ; }
+<fortran77style>{COMM_F77}  { INCREMENT_LINE_NUM() ; }
+{COMM_F90}                  { INCREMENT_LINE_NUM() ; }
+{COMM_F90_2}                {}
+%%
+
+void out_of_donottreat ( void )
+{
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
+}
Index: vendors/AGRIF/LEX/fortran.y
===================================================================
--- vendors/AGRIF/LEX/fortran.y	(revision 9621)
+++ vendors/AGRIF/LEX/fortran.y	(revision 9621)
@@ -0,0 +1,2225 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http ://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+%{
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
+int c_selectorgiven=0;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+int removeline=0;
+listvar *test;
+
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+%}
+
+%union {
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+}
+
+%left ','
+%nonassoc ':'
+%right '='
+%left TOK_EQV TOK_NEQV
+%left TOK_OR TOK_XOR
+%left TOK_AND
+%left TOK_NOT
+%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
+%left TOK_DSLASH
+%left '+' '-'
+%left '*' TOK_SLASH
+%right TOK_DASTER
+
+%token TOK_SEMICOLON
+%token TOK_PARAMETER
+%token TOK_RESULT
+%token TOK_ONLY
+%token TOK_INCLUDE
+%token TOK_SUBROUTINE
+%token TOK_PROGRAM
+%token TOK_FUNCTION
+%token TOK_FORMAT
+%token TOK_MAX
+%token TOK_TANH
+%token TOK_WHERE
+%token TOK_ELSEWHEREPAR
+%token TOK_ELSEWHERE
+%token TOK_ENDWHERE
+%token TOK_MAXVAL
+%token TOK_TRIM
+%token TOK_NULL_PTR
+%token TOK_SUM
+%token TOK_SQRT
+%token TOK_CASE
+%token TOK_SELECTCASE
+%token TOK_FILE
+%token TOK_UNIT
+%token TOK_FMT
+%token TOK_NML
+%token TOK_END
+%token TOK_EOR
+%token TOK_ERR
+%token TOK_EXIST
+%token TOK_MIN
+%token TOK_FLOAT
+%token TOK_EXP
+%token TOK_COS
+%token TOK_COSH
+%token TOK_ACOS
+%token TOK_NINT
+%token TOK_CYCLE
+%token TOK_SIN
+%token TOK_SINH
+%token TOK_ASIN
+%token TOK_EQUIVALENCE
+%token TOK_BACKSPACE
+%token TOK_LOG
+%token TOK_TAN
+%token TOK_ATAN
+%token TOK_RECURSIVE
+%token TOK_ABS
+%token TOK_MOD
+%token TOK_SIGN
+%token TOK_MINLOC
+%token TOK_MAXLOC
+%token TOK_EXIT
+%token TOK_MINVAL
+%token TOK_PUBLIC
+%token TOK_PRIVATE
+%token TOK_ALLOCATABLE
+%token TOK_RETURN
+%token TOK_THEN
+%token TOK_ELSEIF
+%token TOK_ELSE
+%token TOK_ENDIF
+%token TOK_PRINT
+%token TOK_PLAINGOTO
+%token TOK_LOGICALIF
+%token TOK_PLAINDO
+%token TOK_CONTAINS
+%token TOK_ENDDO
+%token TOK_MODULE
+%token TOK_ENDMODULE
+%token TOK_WHILE
+%token TOK_CONCURRENT
+%token TOK_ALLOCATE
+%token TOK_OPEN
+%token TOK_CLOSE
+%token TOK_INQUIRE
+%token TOK_WRITE
+%token TOK_FLUSH
+%token TOK_READ
+%token TOK_REWIND
+%token TOK_DEALLOCATE
+%token TOK_NULLIFY
+%token TOK_DIMENSION
+%token TOK_ENDSELECT
+%token TOK_EXTERNAL
+%token TOK_INTENT
+%token TOK_INTRINSIC
+%token TOK_NAMELIST
+%token TOK_DEFAULT
+%token TOK_OPTIONAL
+%token TOK_POINTER
+%token TOK_CONTINUE
+%token TOK_SAVE
+%token TOK_TARGET
+%token TOK_IMPLICIT
+%token TOK_NONE
+%token TOK_CALL
+%token TOK_STAT
+%token TOK_POINT_TO
+%token TOK_COMMON
+%token TOK_GLOBAL
+%token TOK_LEFTAB
+%token TOK_RIGHTAB
+%token TOK_PAUSE
+%token TOK_PROCEDURE
+%token TOK_STOP
+%token TOK_REAL8
+%token TOK_FOURDOTS
+%token <na> TOK_HEXA
+%token <na> TOK_ASSIGNTYPE
+%token <na> TOK_OUT
+%token <na> TOK_INOUT
+%token <na> TOK_IN
+%token <na> TOK_USE
+%token <na> TOK_DSLASH
+%token <na> TOK_DASTER
+%token <na> TOK_EQ
+%token <na> TOK_EQV
+%token <na> TOK_GT
+%token <na> TOK_LT
+%token <na> TOK_GE
+%token <na> TOK_NE
+%token <na> TOK_NEQV
+%token <na> TOK_LE
+%token <na> TOK_OR
+%token <na> TOK_XOR
+%token <na> TOK_NOT
+%token <na> TOK_AND
+%token <na> TOK_TRUE
+%token <na> TOK_FALSE
+%token <na> TOK_LABEL
+%token <na> TOK_TYPE
+%token <na> TOK_TYPEPAR
+%token <na> TOK_ENDTYPE
+%token <na> TOK_REAL
+%token <na> TOK_INTEGER
+%token <na> TOK_LOGICAL
+%token <na> TOK_DOUBLEPRECISION
+%token <na> TOK_ENDSUBROUTINE
+%token <na> TOK_ENDFUNCTION
+%token <na> TOK_ENDPROGRAM
+%token <na> TOK_ENDUNIT
+%token <na> TOK_CHARACTER
+%token <na> TOK_CHAR_CONSTANT
+%token <na> TOK_CHAR_CUT
+%token <na> TOK_DATA
+%token <na> TOK_CHAR_MESSAGE
+%token <na> TOK_CSTREAL
+%token <na> TOK_COMPLEX
+%token <na> TOK_DOUBLECOMPLEX
+%token <na> TOK_NAME
+%token <na> TOK_SLASH
+%token <na> TOK_CSTINT
+%token ','
+%token ':'
+%token '('
+%token ')'
+%token '<'
+%token '>'
+%type <l> dcl
+%type <l> after_type
+%type <l> dimension
+%type <l> paramlist
+%type <l> args
+%type <l> arglist
+%type <lc> only_list
+%type <lc> only_name
+%type <lc> rename_list
+%type <lc> rename_name
+%type <d> dims
+%type <d> dimlist
+%type <dim1> dim
+%type <v> paramitem
+%type <na> comblock
+%type <na> name_routine
+%type <na> opt_name
+%type <na> type
+%type <na> word_endsubroutine
+%type <na> word_endfunction
+%type <na> word_endprogram
+%type <na> word_endunit
+%type <na> typespec
+%type <na> string_constant
+%type <na> simple_const
+%type <na> ident
+%type <na> intent_spec
+%type <na> signe
+%type <na> opt_signe
+%type <na> filename
+%type <na> attribute
+%type <na> complex_const
+%type <na> begin_array
+%type <na> clause
+%type <na> arg
+%type <na> uexpr
+%type <na> minmaxlist
+%type <na> lhs
+%type <na> vec
+%type <na> outlist
+%type <na> other
+%type <na> dospec
+%type <na> expr_data
+%type <na> structure_component
+%type <na> array_ele_substring_func_ref
+%type <na> funarglist
+%type <na> funarg
+%type <na> funargs
+%type <na> triplet
+%type <na> substring
+%type <na> opt_substring
+%type <na> opt_expr
+%type <na> optexpr
+%type <lnn> data_stmt_value_list
+%type <lnn> datanamelist
+%type <na> after_slash
+%type <na> after_equal
+%type <na> predefinedfunction
+%type <na> expr
+%type <na> ubound
+%type <na> operation
+%type <na> proper_lengspec
+%type <lnn> use_name_list
+%type <lnn> public
+
+%%
+input :
+      | input line
+      ;
+line :  line-break
+      | suite_line_list
+      | TOK_LABEL suite_line_list
+      | error {yyerrok;yyclearin;}
+      ;
+line-break:
+        '\n' fin_line
+      | TOK_SEMICOLON
+      | line-break '\n' fin_line
+      | line-break TOK_SEMICOLON
+      | line-break TOK_LABEL
+      ;
+suite_line_list :
+        suite_line
+      | suite_line_list TOK_SEMICOLON '\n'
+      | suite_line_list TOK_SEMICOLON suite_line
+      ;
+suite_line :
+        entry fin_line     /* subroutine, function, module                    */
+      | spec fin_line      /* declaration                                     */
+      | TOK_INCLUDE filename fin_line
+        {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+      | execution-part-construct
+      ;
+
+fin_line : { pos_cur = setposcur(); }
+      ;
+
+opt_recursive :         { isrecursive = 0; }
+      | TOK_RECURSIVE   { isrecursive = 1; }
+      ;
+
+opt_result :                                { is_result_present = 0; }
+      | TOK_RESULT arglist_after_result     { is_result_present = 1; }
+      ;
+
+entry : opt_recursive TOK_SUBROUTINE name_routine arglist
+        {
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1($4);
+            else
+                WriteBeginof_SubLoop();
+        }
+      | TOK_PROGRAM name_routine
+        {
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
+      | opt_recursive TOK_FUNCTION name_routine arglist opt_result
+        {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($4);
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1($3);
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
+      | TOK_MODULE TOK_NAME
+        {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,$2);
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1($2);
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
+      ;
+
+/* R312 : label */
+label: TOK_CSTINT
+     | label TOK_CSTINT
+     ;
+
+name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
+      ;
+filename :      TOK_CHAR_CONSTANT { Add_Include_1($1); }
+      ;
+arglist :               { if ( firstpass ) $$=NULL; }
+      | '(' ')'         { if ( firstpass ) $$=NULL; }
+      | '(' args ')'    { if ( firstpass ) $$=$2; }
+      ;
+arglist_after_result:
+      | '(' ')'
+      | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
+      ;
+args :  arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($1,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                $$ = settype("",curlistvar);
+            }
+        }
+      | args ',' arg
+        {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar($3,NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                $$ = insertvar($1,curvar);
+            }
+        }
+      ;
+arg : TOK_NAME  { strcpy($$,$1);  }
+      | '*'     { strcpy($$,"*"); }
+      ;
+spec :  type after_type
+      | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; }
+      | TOK_ENDTYPE opt_name                { inside_type_declare = 0; }
+      | TOK_POINTER list_couple
+      | before_parameter '(' paramlist ')'
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($3);
+                    else                        Add_GlobalParameter_Var_1($3);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | before_parameter paramlist
+        {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1($2);
+                    else                        Add_GlobalParameter_Var_1($2);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+      | common
+      | save
+        {
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+      | implicit
+      | dimension
+        {
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1($1);
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+      | public
+        {
+            if (firstpass == 0)
+            {
+                if ($1)
+                {
+                    removeglobfromlist(&($1));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic($1);
+                }
+            }
+        }
+      | private
+      | use_stat
+      | module_proc_stmt
+      | namelist
+      | TOK_BACKSPACE '(' expr ')'
+      | TOK_EXTERNAL opt_sep use_name_list
+      | TOK_INTRINSIC opt_sep use_intrinsic_list
+      | TOK_EQUIVALENCE list_expr_equi
+      | data_stmt '\n'
+        {
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+      ;
+opt_spec :
+      | access_spec
+        {
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+      ;
+name_intrinsic :
+        TOK_SUM
+      | TOK_TANH
+      | TOK_MAXVAL
+      | TOK_MIN
+      | TOK_MINVAL
+      | TOK_TRIM
+      | TOK_SQRT
+      | TOK_NINT
+      | TOK_FLOAT
+      | TOK_EXP
+      | TOK_COS
+      | TOK_COSH
+      | TOK_ACOS
+      | TOK_SIN
+      | TOK_SINH
+      | TOK_ASIN
+      | TOK_LOG
+      | TOK_TAN
+      | TOK_ATAN
+      | TOK_MOD
+      | TOK_SIGN
+      | TOK_MINLOC
+      | TOK_MAXLOC
+      | TOK_NAME
+      ;
+use_intrinsic_list :
+                               name_intrinsic
+      | use_intrinsic_list ',' name_intrinsic
+      ;
+list_couple :
+                        '(' list_expr ')'
+      | list_couple ',' '(' list_expr ')'
+      ;
+list_expr_equi :
+                           expr_equi
+      | list_expr_equi ',' expr_equi
+      ;
+expr_equi : '(' list_expr_equi1 ')'
+      ;
+list_expr_equi1 :
+                            ident dims
+      | list_expr_equi1 ',' ident dims
+      ;
+list_expr :
+                      expr
+      | list_expr ',' expr
+      ;
+opt_sep :
+      | TOK_FOURDOTS
+      ;
+after_type :
+        dcl nodimsgiven
+        {
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01($1);
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                $$ = $1;
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1($1);
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
+                        Add_Parameter_Var_1($1);
+                    }
+                    else
+                        Add_GlobalParameter_Var_1($1);
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
+                        else                Add_Save_Var_dcl_1($1);
+                    }
+                }
+            }
+            else
+            {
+                $$ = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+      | before_function name_routine arglist
+        {
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1($3);
+                Add_FunctionType_Var_1($2);
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+      ;
+before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
+      ;
+before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+      ;
+
+data_stmt :             /* R534 */
+        TOK_DATA data_stmt_set_list
+
+data_stmt_set_list :
+        data_stmt_set
+      | data_stmt_set_list opt_comma data_stmt_set
+
+data_stmt_set :         /* R535 */
+        TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$3);
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
+        }
+      | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
+        }
+      | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
+        {
+            createstringfromlistname(ligne,$7);
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,$2,$4,ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+      ;
+
+data_stmt_value_list :
+        expr_data                           { $$ = Insertname(NULL,$1,0); }
+      | expr_data ',' data_stmt_value_list  { $$ = Insertname($3,$1,1);   }
+      ;
+
+save :  before_save varsave
+      | before_save comblock varsave
+      | save opt_comma comblock opt_comma varsave
+      | save ',' varsave
+      ;
+before_save :
+        TOK_SAVE        { pos_cursave = setposcur()-4; }
+      ;
+varsave :
+      | TOK_NAME dims   { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
+      ;
+datanamelist :
+        TOK_NAME                        { $$ = Insertname(NULL,$1,0); }
+      | TOK_NAME '(' expr ')'           { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+      | datanamelist ',' datanamelist   { $$ = concat_listname($1,$3); }
+      ;
+expr_data :
+        opt_signe simple_const      { sprintf($$,"%s%s",$1,$2);  }
+      | expr_data '+' expr_data     { sprintf($$,"%s+%s",$1,$3); }
+      | expr_data '-' expr_data     { sprintf($$,"%s-%s",$1,$3); }
+      | expr_data '*' expr_data     { sprintf($$,"%s*%s",$1,$3); }
+      | expr_data '/' expr_data     { sprintf($$,"%s/%s",$1,$3); }
+      ;
+opt_signe :     { strcpy($$,""); }
+      | signe   { strcpy($$,$1); }
+      ;
+namelist :
+        TOK_NAMELIST ident
+      | TOK_NAMELIST comblock ident
+      | namelist opt_comma comblock opt_comma ident
+      | namelist ',' ident
+      ;
+before_dimension :
+        TOK_DIMENSION
+        {
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+
+dimension :
+        before_dimension opt_comma TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            $$ = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+      | dimension ',' TOK_NAME dims lengspec
+        {
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3);
+            if ( inside_type_declare ) break;
+            curvar = createvar($3,$4);
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar($1, curvar);
+            $$ = curlistvar;
+            strcpy(vallengspec,"");
+        }
+      ;
+private :
+        TOK_PRIVATE '\n'
+      | TOK_PRIVATE opt_sep use_name_list
+      ;
+public :
+        TOK_PUBLIC '\n'                     { $$ = (listname *) NULL; }
+      | TOK_PUBLIC opt_sep use_name_list    { $$ = $3; }
+      ;
+use_name_list :
+        TOK_NAME                            { $$ = Insertname(NULL,$1,0); }
+      | TOK_ASSIGNTYPE                      { $$ = Insertname(NULL,$1,0); }
+      | use_name_list ',' TOK_NAME          { $$ = Insertname($1,$3,0);   }
+      | use_name_list ',' TOK_ASSIGNTYPE    { $$ = Insertname($1,$3,0);   }
+      ;
+common :
+        before_common var_common_list
+        {
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | before_common comblock var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$2);
+            Add_NameOfCommon_1($2,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      | common opt_comma comblock opt_comma var_common_list
+        {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",$3);
+            Add_NameOfCommon_1($3,subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+      ;
+before_common :
+        TOK_COMMON              { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+      | TOK_GLOBAL TOK_COMMON   { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+      ;
+var_common_list :
+        var_common                      { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      | var_common_list ',' var_common  { if ( ! inside_type_declare ) Add_Common_var_1(); }
+      ;
+var_common :
+        TOK_NAME dims
+        {
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,$1);
+            commondim = $2;
+        }
+      ;
+comblock :
+        TOK_DSLASH
+        {
+            strcpy($$,"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+      | TOK_SLASH TOK_NAME TOK_SLASH
+        {
+            strcpy($$,$2);
+            positioninblock=0;
+            strcpy(commonblockname,$2);
+        }
+      ;
+opt_comma :
+      | ','
+      ;
+paramlist :
+        paramitem                   { $$=insertvar(NULL,$1); }
+      | paramlist ',' paramitem     { $$=insertvar($1,$3);   }
+      ;
+paramitem :
+        TOK_NAME '=' expr
+        {
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,$1);
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,$3);
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length($3,14);
+            $$ = curvar;
+        }
+      ;
+module_proc_stmt :
+        TOK_PROCEDURE proc_name_list
+      ;
+proc_name_list :
+        TOK_NAME
+      | proc_name_list ',' TOK_NAME
+      ;
+implicit :
+        TOK_IMPLICIT TOK_NONE
+        {
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+      | TOK_IMPLICIT TOK_REAL8
+      ;
+dcl :   options TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($2,curdim);
+                else                curvar = createvar($2,$3);
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+      | dcl ',' TOK_NAME dims lengspec initial_value
+        {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar($3, curdim);
+                else                curvar = createvar($3, $4);
+                CreateAndFillin_Curvar($1->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, $1->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar($1, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                $$=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+      ;
+nodimsgiven : { dimsgiven = 0; }
+      ;
+type :  typespec selector               { strcpy(DeclType,$1);  }
+      | before_character c_selector     { strcpy(DeclType,"character");  }
+      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
+      | TOK_TYPEPAR attribute ')'       { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+      ;
+c_selector :
+      | '*' TOK_CSTINT              { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
+      | '*' '(' c_attribute ')'     { c_star = 1;}
+      | '(' c_attribute ')'
+      ;
+c_attribute :
+        TOK_NAME clause opt_clause
+      | TOK_NAME '=' clause opt_clause
+      | clause opt_clause
+      ;
+before_character : TOK_CHARACTER    { pos_cur_decl = setposcur()-9; }
+      ;
+typespec :
+        TOK_INTEGER         { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
+      | TOK_LOGICAL         { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
+      | TOK_REAL            { strcpy($$,"real");    pos_cur_decl = setposcur()-4; }
+      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
+      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
+      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
+      ;
+lengspec :
+      | '*' proper_lengspec {strcpy(vallengspec,$2);}
+      ;
+proper_lengspec :
+        expr        { sprintf($$,"*%s",$1); }
+      | '(' '*' ')' { strcpy($$,"*(*)"); }
+      ;
+selector :
+      | '*' proper_selector
+      | '(' attribute ')'
+      ;
+proper_selector : expr
+      | '(' '*' ')'
+      ;
+attribute :
+        TOK_NAME clause
+      | TOK_NAME '=' clause
+        {
+            if ( strstr($3,"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",$1,$3);
+        }
+      | TOK_NAME        { strcpy(NamePrecision,$1); }
+      | TOK_CSTINT      { strcpy(NamePrecision,$1); }
+      | TOK_ASSIGNTYPE  { strcpy(NamePrecision,$1); }
+      ;
+clause :
+        expr   { strcpy(CharacterSize,$1);  strcpy($$,$1);  }
+      | '*'    { strcpy(CharacterSize,"*"); strcpy($$,"*"); }
+      ;
+opt_clause :
+      | ',' TOK_NAME clause
+      ;
+options :
+      | TOK_FOURDOTS
+      | ',' attr_spec_list TOK_FOURDOTS
+      ;
+attr_spec_list : attr_spec
+      | attr_spec_list ',' attr_spec
+      ;
+attr_spec :
+        TOK_PARAMETER       { VariableIsParameter = 1; }
+      | access_spec
+      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
+      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
+      | TOK_EXTERNAL        { ExternalDeclare = 1; }
+      | TOK_INTENT '(' intent_spec ')'
+                            { strcpy(IntentSpec,$3); }
+      | TOK_INTRINSIC
+      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
+      | TOK_POINTER         { pointerdeclare = 1 ; }
+      | TOK_SAVE            { SaveDeclare = 1 ; }
+      | TOK_TARGET          { Targetdeclare = 1; }
+      ;
+intent_spec :
+        TOK_IN          { strcpy($$,$1); }
+      | TOK_OUT         { strcpy($$,$1); }
+      | TOK_INOUT       { strcpy($$,$1); }
+      ;
+access_spec :
+        TOK_PUBLIC      { PublicDeclare = 1;  }
+      | TOK_PRIVATE     { PrivateDeclare = 1; }
+      ;
+dims :  { $$ = (listdim*) NULL; }
+      | '(' dimlist ')'
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
+        }
+      ;
+dimlist :
+        dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
+        }
+      | dimlist ',' dim
+        {
+            $$ = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
+        }
+      ;
+dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
+      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
+      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
+      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
+      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
+      ;
+ubound :
+        '*'                 { strcpy($$,"*"); }
+      | expr                { strcpy($$,$1);  }
+      ;
+expr :  uexpr               { strcpy($$,$1); }
+      | complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
+      ;
+
+predefinedfunction :
+        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
+      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
+      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
+      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
+      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
+      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
+      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
+      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
+      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
+      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
+      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
+      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
+      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
+      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
+      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
+      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
+      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
+      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
+      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
+      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
+      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
+      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
+      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
+      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
+      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
+      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
+      ;
+minmaxlist : expr {strcpy($$,$1);}
+      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
+      ;
+uexpr : lhs                     { strcpy($$,$1); }
+      | simple_const            { strcpy($$,$1); }
+      | vec                     { strcpy($$,$1); }
+      | expr operation          { sprintf($$,"%s%s",$1,$2); }
+      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
+      ;
+signe : '+'        { strcpy($$,"+"); }
+      | '-'        { strcpy($$,"-"); }
+      ;
+
+operation :
+        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
+      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
+      | '*' expr                    { sprintf($$,"*%s",$2); }
+      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
+      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
+      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
+      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
+      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
+      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
+      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
+      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
+      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
+      | '=' after_equal             { sprintf($$,"%s",$2); }
+
+after_slash :                   { strcpy($$,""); }
+      | expr                    { sprintf($$,"/%s",$1); }
+      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
+      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
+      ;
+after_equal :
+        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
+      | expr                    { sprintf($$,"= %s",$1); }
+      ;
+
+lhs :   ident                           { strcpy($$,$1); }
+      | structure_component             { strcpy($$,$1); }
+      | array_ele_substring_func_ref    { strcpy($$,$1); }
+      ;
+
+beforefunctionuse :
+        {
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+array_ele_substring_func_ref :
+        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
+      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
+      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
+      ;
+begin_array :
+        ident '(' funarglist ')'
+        {
+            if ( inside_type_declare ) break;
+            sprintf($$," %s ( %s )",$1,$3);
+            ModifyTheAgrifFunction_0($3);
+            agrif_parentcall = 0;
+        }
+      ;
+structure_component :
+        lhs '%' declare_after_percent lhs
+        {
+            sprintf($$," %s %% %s ",$1,$4);
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+      ;
+vec :
+        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
+      ;
+funarglist :
+        beforefunctionuse           { strcpy($$," "); }
+      | beforefunctionuse funargs   { strcpy($$,$2); }
+      ;
+funargs :
+        funarg              {  strcpy($$,$1); }
+      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
+      ;
+funarg :
+        expr       {strcpy($$,$1);}
+      | triplet    {strcpy($$,$1);}
+      ;
+triplet :
+        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
+      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
+      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
+      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
+      | ':' expr                {  sprintf($$,":%s",$2);}
+      | expr ':'                {  sprintf($$,"%s :",$1);}
+      | ':'                     {  sprintf($$,":");}
+      ;
+ident : TOK_NAME
+        {
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction($1) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp($1,identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,$1);
+                    pointedvar = 0;
+
+                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
+                    else                    strcpy(truename, $1);
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
+                            {
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
+                            }
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+      ;
+simple_const :
+        TOK_TRUE     { strcpy($$,".TRUE.");}
+      | TOK_FALSE    { strcpy($$,".FALSE.");}
+      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
+      | TOK_CSTINT   { strcpy($$,$1); }
+      | TOK_CSTREAL  { strcpy($$,$1); }
+      | TOK_HEXA     { strcpy($$,$1); }
+      | simple_const TOK_NAME
+                     { sprintf($$,"%s%s",$1,$2); }
+      | string_constant opt_substring
+      ;
+string_constant :
+        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
+      | string_constant TOK_CHAR_CONSTANT
+      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
+      | TOK_CHAR_CUT                        { strcpy($$,$1);}
+      ;
+opt_substring :     { strcpy($$," ");}
+      | substring   { strcpy($$,$1);}
+      ;
+substring :
+        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
+      ;
+optexpr :           { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+opt_expr :
+        '\n'        { strcpy($$," ");}
+      | expr        { strcpy($$,$1);}
+      ;
+initial_value :     { InitialValueGiven = 0; }
+      | '=' expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 1;
+        }
+      | TOK_POINT_TO expr
+        {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,$2);
+            InitialValueGiven = 2;
+        }
+      ;
+complex_const :
+        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
+      ;
+use_stat :
+        word_use TOK_NAME
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", $2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use TOK_NAME ',' rename_list
+        {
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$4);
+                    coupletmp = $4;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+      | word_use TOK_NAME ',' TOK_ONLY ':' '\n'
+        {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",$2);
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1($2);
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0($2);
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+      | word_use  TOK_NAME ',' TOK_ONLY ':' only_list
+        {
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1($2,$6);
+                    coupletmp = $6;
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",$2);
+                }
+                Add_NameOfModuleUsed_1($2);
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
+                }
+            }
+        }
+      ;
+word_use :
+        TOK_USE
+        {
+            pos_curuse = setposcur()-strlen($1);
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+      ;
+rename_list :
+        rename_name
+        {
+            $$ = $1;
+        }
+      | rename_list ',' rename_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+only_list :
+        only_name   {  $$ = $1; }
+      | only_list ',' only_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+only_name :
+        TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1($1);
+        }
+      | TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+
+/* R209 : execution-part-construct */
+execution-part-construct:
+        executable-construct
+      | format-stmt
+      ;
+
+/* R213 : executable-construct */
+executable-construct:
+        action-stmt
+      | do-construct
+      | case-construct
+      | if-construct
+      | where-construct
+      ;
+
+/* R214 : action-stmt */
+action-stmt :
+        TOK_CONTINUE
+      | ident_dims after_ident_dims
+      | goto
+      | call
+      | iofctl ioctl
+      | read option_read
+      | TOK_WRITE ioctl
+      | TOK_WRITE ioctl outlist
+      | TOK_REWIND after_rewind
+      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; }
+      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; }
+      | TOK_EXIT optexpr
+      | TOK_RETURN opt_expr
+      | TOK_CYCLE opt_expr
+      | stop opt_expr
+      | int_list
+      | TOK_NULLIFY '(' pointer_name_list ')'
+      | word_endunit
+        {
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+      | word_endprogram opt_name
+        {
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | word_endsubroutine opt_name
+        {
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+      | word_endfunction opt_name
+        {
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+      | TOK_ENDMODULE opt_name
+        {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+      | if-stmt
+      | where-stmt
+      | TOK_CONTAINS
+        {
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+      ;
+
+/* R601 : variable */
+//variable : expr
+//       ;
+
+/* R734 : assignment-stmt */
+// assignment-stmt: variable '=' expr
+//       ;
+assignment-stmt: expr
+      ;
+
+/* R741 : where-stmt */
+where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
+      ;
+
+/* R742 : where-construct */
+where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
+      ;
+
+opt-where-body-construct:
+      | opt-where-body-construct where-body-construct line-break
+      ;
+
+opt-masked-elsewhere-construct :
+      | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+opt-elsewhere-construct:
+      | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
+      ;
+
+/* R743 : where-construct-stmt */
+where-construct-stmt:
+        TOK_WHERE '(' mask-expr ')'
+      ;
+
+/* R744 : where-body-construct */
+where-body-construct: where-assignment-stmt
+      | where-stmt
+      | where-construct
+      ;
+
+/* R745 : where-assignment-stmt */
+where-assignment-stmt: assignment-stmt
+      ;
+
+/* R746 : mask-expr */
+mask-expr: expr
+      ;
+
+/* R747 : masked-elsewhere-stmt */
+masked-elsewhere-stmt:
+        TOK_ELSEWHEREPAR mask-expr ')'
+      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
+      ;
+
+/* R748: elsewhere-stmt */
+elsewhere-stmt:
+        TOK_ELSEWHERE
+      | TOK_ELSEWHERE TOK_NAME
+      ;
+
+/* R749: end-where-stmt */
+end-where-stmt:
+        TOK_ENDWHERE
+      | TOK_ENDWHERE TOK_NAME
+      ;
+
+/* R752 : forall-header */
+forall-header :
+     ;
+
+/* R801 : block */
+block:
+      |block execution-part-construct
+      |block execution-part-construct line-break
+      ;
+
+/* R813 : do-construct */
+do-construct:
+        block-do-construct
+      ;
+
+/* R814 : block-do-construct */
+block-do-construct:
+        do-stmt line-break do-block end-do
+      ;
+
+/* R815 : do-stmt */
+do-stmt:
+        label-do-stmt
+      | nonlabel-do-stmt
+      ;
+
+/* R816 : label-do-stmt */
+label-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO label
+      |              TOK_PLAINDO label
+      | TOK_NAME ':' TOK_PLAINDO label loop-control
+      |              TOK_PLAINDO label loop-control
+      ;
+
+/* R817 : nonlabel-do-stmt */
+nonlabel-do-stmt:
+        TOK_NAME ':' TOK_PLAINDO
+      |              TOK_PLAINDO
+      | TOK_NAME ':' TOK_PLAINDO loop-control
+      |              TOK_PLAINDO loop-control
+      ;
+
+/* R818 : loop-control */
+loop-control:
+        opt_comma do-variable '=' expr ',' expr
+      | opt_comma do-variable '=' expr ',' expr ',' expr
+      | opt_comma TOK_WHILE '(' expr ')'
+      | opt_comma TOK_CONCURRENT forall-header
+      ;
+
+/* R819 : do-variable */
+do-variable : ident
+     ;
+
+/* R820 : do-block */
+do-block: block
+     ;
+
+/* R821 : end-do */
+end-do: end-do-stmt
+     | continue-stmt
+     ;
+
+/* R822 : end-do-stmt */
+end-do-stmt:
+        TOK_ENDDO
+      | TOK_ENDDO TOK_NAME
+      ;
+
+/* R832 : if-construct */
+if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
+      ;
+
+opt-else-if-stmt-block:
+      | else-if-stmt-block
+      | opt-else-if-stmt-block else-if-stmt-block
+      ;
+
+else-if-stmt-block:
+        else-if-stmt line-break block
+      ;
+
+opt-else-stmt-block:
+      | else-stmt-block
+      | opt-else-stmt-block else-if-stmt-block
+      ;
+
+else-stmt-block: else-stmt line-break block
+        ;
+
+/* R833 : if-then-stmt */
+if-then-stmt:
+         TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
+      |               TOK_LOGICALIF '(' expr ')' TOK_THEN
+      ;
+
+/* R834 : else-if-stmt */
+else-if-stmt:
+        TOK_ELSEIF '(' expr ')' TOK_THEN
+      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
+      ;
+
+/* R835 : else-stmt */
+else-stmt:
+        TOK_ELSE
+      | TOK_ELSE TOK_NAME
+      ;
+
+/* R836 : end-if-stmt */
+end-if-stmt:
+        TOK_ENDIF
+      | TOK_ENDIF TOK_NAME
+      ;
+
+/* R837 : if-stmt */
+if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
+        ;
+
+/* R838 : case-construct */
+case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
+        ;
+
+opt_case-stmt-block:
+        | case-stmt-block
+        | opt_case-stmt-block case-stmt-block
+        ;
+
+case-stmt-block: case-stmt line-break block
+        ;
+
+/* R839 : select-case-stmt */
+select-case-stmt :
+          TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
+        |              TOK_SELECTCASE '(' expr ')'
+        ;
+
+/* R840 : case-stmt */
+case-stmt:
+          TOK_CASE case-selector
+        | TOK_CASE case-selector TOK_NAME
+        ;
+
+/* R840 : end-select-stmt */
+end-select-stmt:
+          TOK_ENDSELECT
+        | TOK_ENDSELECT TOK_NAME
+        ;
+
+/* R843 : case-selector */
+case-selector:
+          '(' case-value-range-list ')'
+        | TOK_DEFAULT
+        ;
+
+case-value-range-list:
+        case-value-range
+      | case-value-range-list ',' case-value-range
+      ;
+
+/* R844: case-value-range */
+case-value-range :
+        case-value
+      | case-value ':'
+      | ':' case-value
+      | case-value ':' case-value
+      ;
+
+/* R845 : case-value */
+case-value: expr
+        ;
+
+/* R854 : continue-stmt */
+continue-stmt: TOK_CONTINUE
+        ;
+
+/* R1001 : format-stmt */
+format-stmt: TOK_FORMAT
+        ;
+
+word_endsubroutine :
+        TOK_ENDSUBROUTINE
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+            functiondeclarationisdone = 0;
+        }
+      ;
+word_endunit :
+        TOK_ENDUNIT
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endprogram :
+        TOK_ENDPROGRAM
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+word_endfunction :
+        TOK_ENDFUNCTION
+        {
+            strcpy($$,$1);
+            pos_endsubroutine = setposcur()-strlen($1);
+        }
+      ;
+
+opt_name : '\n'  {strcpy($$,"");}
+      | TOK_NAME {strcpy($$,$1);}
+      ;
+
+before_dims : { created_dimensionlist = 0; }
+      ;
+ident_dims :
+        ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+            if ( ($3 == NULL) || ($4 == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0($3->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+      | ident_dims '%' declare_after_percent ident before_dims dims dims
+        {
+            created_dimensionlist = 1;
+        }
+      ;
+int_list :
+        TOK_CSTINT
+      | int_list ',' TOK_CSTINT
+      ;
+after_ident_dims :
+        '=' expr
+      | TOK_POINT_TO expr
+      ;
+call :  keywordcall opt_call
+        {
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+      ;
+opt_call :
+      | '(' opt_callarglist  ')'
+      ;
+opt_callarglist :
+      | callarglist
+      ;
+keywordcall :
+        before_call TOK_FLUSH
+      | before_call TOK_NAME
+        {
+            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp($2,"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber($2) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+      ;
+before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
+      ;
+callarglist :
+        callarg
+      | callarglist ',' callarg
+      ;
+callarg :
+        expr
+        {
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,$1);
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+      | '*' TOK_CSTINT
+      ;
+
+stop :  TOK_PAUSE
+      | TOK_STOP
+      ;
+
+option_inlist :
+      | inlist
+      ;
+option_read :
+        ioctl option_inlist
+      | infmt opt_inlist
+      ;
+opt_inlist :
+      | ',' inlist
+      ;
+ioctl : '(' ctllist ')'
+      ;
+after_rewind :
+        '(' ident ')'
+      | '(' TOK_CSTINT ')'
+      | TOK_CSTINT
+      | '(' uexpr ')'
+      | TOK_NAME
+      ;
+ctllist :
+        ioclause
+      | ctllist ',' ioclause
+      ;
+ioclause :
+        fexpr
+      | '*'
+      | TOK_DASTER
+      | ident expr dims
+      | ident expr '%' declare_after_percent ident_dims
+      | ident '(' triplet ')'
+      | ident '*'
+      | ident TOK_DASTER
+      ;
+
+declare_after_percent:      { afterpercent = 1; }
+      ;
+iofctl :
+        TOK_OPEN
+      | TOK_CLOSE
+      | TOK_FLUSH
+      ;
+infmt :  unpar_fexpr
+      | '*'
+      ;
+
+read :  TOK_READ
+      | TOK_INQUIRE
+      | TOK_PRINT
+      ;
+
+fexpr : unpar_fexpr
+      | '(' fexpr ')'
+      ;
+unpar_fexpr :
+        lhs
+      | simple_const
+      | fexpr addop fexpr %prec '+'
+      | fexpr '*' fexpr
+      | fexpr TOK_SLASH fexpr
+      | fexpr TOK_DASTER fexpr
+      | addop fexpr %prec '*'
+      | fexpr TOK_DSLASH fexpr
+      | TOK_FILE expr
+      | TOK_UNIT expr
+      | TOK_NML expr
+      | TOK_FMT expr
+      | TOK_EXIST expr
+      | TOK_ERR expr
+      | TOK_END expr
+      | TOK_NAME '=' expr
+      | predefinedfunction
+      ;
+addop : '+'
+      | '-'
+      ;
+inlist : inelt
+      | inlist ',' inelt
+      ;
+// opt_lhs :
+//       | lhs
+//       ;
+inelt : //opt_lhs opt_operation
+        lhs opt_operation
+      | '(' inlist ')' opt_operation
+      | predefinedfunction opt_operation
+      | simple_const opt_operation
+      | '(' inlist ',' dospec ')'
+      ;
+opt_operation :
+      | operation
+      | opt_operation operation
+      ;
+outlist :
+        complex_const       { strcpy($$,$1); }
+      | predefinedfunction  { strcpy($$,$1); }
+      | uexpr               { strcpy($$,$1); }
+      | other               { strcpy($$,$1); }
+      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
+      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
+      ;
+other :
+        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
+dospec :
+        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
+      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
+      ;
+goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
+      | TOK_PLAINGOTO TOK_CSTINT
+      ;
+allocation_list :
+        allocate_object
+      | allocation_list ',' allocate_object
+      ;
+allocate_object :
+        lhs     { Add_Allocate_Var_1($1,curmodulename); }
+      ;
+allocate_object_list :
+        allocate_object
+      | allocate_object_list ',' allocate_object
+      ;
+opt_stat_spec :
+      | ',' TOK_STAT '=' lhs
+      ;
+pointer_name_list :
+        ident
+      | pointer_name_list ',' ident
+      ;
+
+%%
+
+void process_fortran(const char *input_file)
+{
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
+/******************************************************************************/
+/*  1-  Open input file                                                       */
+/******************************************************************************/
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
+}
Index: vendors/AGRIF/LIB/DiversListe.c
===================================================================
--- vendors/AGRIF/LIB/DiversListe.c	(revision 9621)
+++ vendors/AGRIF/LIB/DiversListe.c	(revision 9621)
@@ -0,0 +1,542 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                           Add_Common_var_1                                 */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/*     List_Common_Var                                                        */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Common_var_1()
+{
+    listvar *newvar;
+    listvar *newvar2;
+    variable *newvariable;
+    listdim *dims;
+    char listdimension[LONG_M];
+    char ligne[LONG_M];
+    int out;
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvariable = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvariable);
+
+        strcpy(newvariable->v_nomvar,commonvar);
+        strcpy(newvariable->v_commonname,commonblockname);
+        strcpy(newvariable->v_modulename,curmodulename);
+        strcpy(newvariable->v_subroutinename,subroutinename);
+        strcpy(newvariable->v_commoninfile,cur_filename);
+        newvariable->v_positioninblock = positioninblock;
+        newvariable->v_common = 1;
+        newvar->var = newvariable;
+
+        if ( commondim )
+        {
+            newvariable->v_dimension = commondim;
+            newvariable->v_dimensiongiven = 1;
+            newvariable->v_nbdim = get_num_dims(commondim);
+
+            /* Creation of the string for the dimension of this variable            */
+            dimsempty = 1;
+            strcpy(listdimension,"");
+
+            dims = commondim;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") ||
+                     strcasecmp(dims->dim.last,""))  dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv ) strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvariable->v_dimsempty = 1;
+
+            strcpy(newvariable->v_readedlistdimension,listdimension);
+            Save_Length(listdimension,15);
+        }
+
+        newvar->suiv = NULL;
+
+        if ( !List_Common_Var )
+        {
+            List_Common_Var = newvar;
+        }
+        else
+        {
+            newvar2 = List_Common_Var;
+            out = 0 ;
+            while ( newvar2 && out == 0 )
+            {
+                if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
+                     !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
+                     !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
+                   ) out = 1 ;
+                else newvar2 = newvar2->suiv;
+            }
+            if ( out == 0 )
+            {
+                newvar->suiv = List_Common_Var;
+                List_Common_Var = newvar;
+            }
+            else
+            {
+                free(newvar);
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                           Addtolistnom                                     */
+/******************************************************************************/
+/* This subroutine is used to add a variable to the list                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+listnom *Addtolistnom(const char *nom, listnom *listin, int value)
+{
+    listnom *newnom;
+    listnom *parcours;
+    int out;
+
+    newnom = (listnom*) calloc(1, sizeof(listnom));
+    strcpy(newnom->o_nom, nom);
+    newnom->o_val = value;
+    newnom->suiv = NULL;
+
+    if ( listin == NULL )
+    {
+        listin = newnom;
+    }
+    else
+    {
+        parcours = listin;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom->suiv = listin;
+            listin = newnom;
+        }
+        else
+        {
+            free(newnom);
+        }
+    }
+    return listin;
+}
+
+/******************************************************************************/
+/*                           Addtolistname                                    */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listname *Addtolistname(const char *nom, listname *input)
+{
+    listname *newnom;
+    listname *parcours;
+    int out;
+
+    if ( !input )
+    {
+        newnom = (listname*) calloc(1, sizeof(listname));
+        strcpy(newnom->n_name, nom);
+        newnom->suiv = NULL;
+        input = newnom;
+    }
+    else
+    {
+        parcours = input;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newnom = (listname*) calloc(1,sizeof(listname));
+            strcpy(newnom->n_name, nom);
+            newnom->suiv = input;
+            input = newnom;
+        }
+    }
+    return input;
+}
+
+/******************************************************************************/
+/*                    ModuleIsDefineInInputFile                               */
+/******************************************************************************/
+/* This subroutine is used to know if the module is defined in the input file */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int ModuleIsDefineInInputFile(const char *name)
+{
+    listnom *newnom;
+    int out;
+
+    out = 0;
+    if ( listofmodules )
+    {
+        newnom = listofmodules;
+        while( newnom && out == 0 )
+        {
+            if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
+            else newnom = newnom->suiv;
+        }
+    }
+    return out;
+}
+
+/******************************************************************************/
+/*                      Addmoduletothelisttmp                                 */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/* listusemodule                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... USE mod1 ===> insert in list                      */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  listofmoduletmp                                              */
+/*                                                                            */
+/******************************************************************************/
+void Addmoduletothelisttmp(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    if ( !listofmoduletmp )
+    {
+        newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newmodule->u_usemodule, name);
+        strcpy(newmodule->u_cursubroutine, subroutinename);
+        newmodule->suiv = NULL;
+        listofmoduletmp = newmodule ;
+    }
+    else
+    {
+        parcours = listofmoduletmp;
+        out = 0;
+        while( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1;
+            else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+            strcpy(newmodule->u_usemodule, name);
+            strcpy(newmodule->u_cursubroutine, subroutinename);
+            newmodule->suiv = listofmoduletmp;
+            listofmoduletmp = newmodule;
+        }
+    }
+}
+
+/******************************************************************************/
+/*                          Add_NameOfModule_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfModule_1(const char *nom)
+{
+    listnom *newnom;
+
+    if ( firstpass == 1 )
+    {
+        newnom = (listnom *) calloc(1,sizeof(listnom));
+        strcpy(newnom->o_nom,nom);
+        newnom->suiv = List_NameOfModule;
+        List_NameOfModule = newnom;
+    }
+}
+
+/******************************************************************************/
+/*                          Add_NameOfCommon_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a        variable to the list               */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename)
+{
+    listnom *newnom;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = List_NameOfCommon;
+        while ( parcours && strcasecmp(parcours->o_nom,nom) )
+            parcours = parcours->suiv;
+        if ( !parcours )
+        {
+            newnom = (listnom *) calloc(1,sizeof(listnom));
+            strcpy(newnom->o_nom,nom);
+            strcpy(newnom->o_subroutinename,cursubroutinename);
+            newnom->suiv = List_NameOfCommon;
+            List_NameOfCommon = newnom;
+        }
+    }
+}
+
+/******************************************************************************/
+/*                     Add_CouplePointed_Var_1                                */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the listvarpointtovar                                   */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple)
+{
+    listvarpointtovar *pointtmp;
+
+    /* we should complete the List_CouplePointed_Var                        */
+    pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar));
+    strcpy(pointtmp->t_usemodule, namemodule);
+    strcpy(pointtmp->t_cursubroutine, subroutinename);
+    pointtmp->t_couple = couple;
+    if ( List_CouplePointed_Var )
+    {
+        pointtmp->suiv = List_CouplePointed_Var;
+    }
+    else
+    {
+        pointtmp->suiv = NULL;
+    }
+    List_CouplePointed_Var = pointtmp;
+}
+
+/******************************************************************************/
+/*                           Add_Include_1                                    */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/*  List_Include                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... include mod1 ===> insert in list                  */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  List_Include                                                 */
+/*                                                                            */
+/******************************************************************************/
+void Add_Include_1(const char *name)
+{
+    listusemodule *newinclude;
+
+    if ( firstpass == 1 )
+    {
+        newinclude = (listusemodule*) calloc(1, sizeof(listusemodule));
+        strcpy(newinclude->u_usemodule,name);
+        strcpy(newinclude->u_cursubroutine,subroutinename);
+
+        newinclude->suiv = List_Include;
+        List_Include  = newinclude ;
+    }
+}
+
+/******************************************************************************/
+/*                     Add_ImplicitNoneSubroutine_1                           */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Add_ImplicitNoneSubroutine_1()
+{
+    if ( firstpass == 1 )
+        List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine);
+}
+
+/******************************************************************************/
+/*                        WriteIncludeDeclaration                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteIncludeDeclaration(FILE* tofile)
+{
+  listusemodule *newinclude;
+
+  newinclude = List_Include;
+  fprintf(tofile,"\n");
+  while ( newinclude )
+  {
+     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
+     {
+        fprintf(tofile, "      include %s\n",newinclude->u_usemodule);
+     }
+     newinclude = newinclude ->suiv;
+  }
+}
+
+/******************************************************************************/
+/*                          Add_Save_Var_1                                    */
+/******************************************************************************/
+/* This subroutine is used to add a record to List_Save_Var                   */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ Save +--->+ Save +--->+ Save +--->+  Save+             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void Add_Save_Var_1 (const char *name, listdim *d)
+{
+    listvar *newvar;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    if ( firstpass == 1 )
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        newvar->var->v_save = 1;
+        strcpy(newvar->var->v_nomvar,name);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+
+        newvar->var->v_dimension = d;
+
+        /* Creation of the string for the dimension of this variable             */
+        dimsempty = 1;
+
+        if ( d )
+        {
+            newvar->var->v_dimensiongiven = 1;
+            dims = d;
+            while (dims)
+            {
+                if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+                    dimsempty = 0;
+                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                strcat(listdimension,ligne);
+                if ( dims->suiv )   strcat(listdimension,",");
+                dims = dims->suiv;
+            }
+            if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1;
+        }
+
+        newvar->suiv = List_Save_Var;
+        List_Save_Var = newvar;
+    }
+}
+
+void Add_Save_Var_dcl_1 (listvar *var)
+{
+    listvar *newvar;
+    listvar *parcours;
+
+    if ( firstpass == 1 )
+    {
+        parcours = var;
+        while ( parcours )
+        {
+            newvar = (listvar *) calloc(1,sizeof(listvar));
+            newvar->var = (variable *) calloc(1,sizeof(variable));
+
+            Init_Variable(newvar->var);
+
+            newvar->var->v_save = 1;
+            strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+            strcpy(newvar->var->v_modulename,curmodulename);
+            strcpy(newvar->var->v_subroutinename,subroutinename);
+            strcpy(newvar->var->v_commoninfile,cur_filename);
+            strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension);
+
+            newvar->var->v_nbdim = parcours->var->v_nbdim;
+            newvar->var->v_catvar = parcours->var->v_catvar;
+            newvar->var->v_dimension = parcours->var->v_dimension;
+            newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
+            newvar->suiv = List_Save_Var;
+            List_Save_Var = newvar;
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: vendors/AGRIF/LIB/Makefile
===================================================================
--- vendors/AGRIF/LIB/Makefile	(revision 9621)
+++ vendors/AGRIF/LIB/Makefile	(revision 9621)
@@ -0,0 +1,66 @@
+OBJS = main.o WriteInFile.o toamr.o fortran.o  \
+       dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \
+       WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \
+       Writedeclarations.o WorkWithglobliste.o UtilFortran.o \
+       UtilNotGridDep.o WorkWithlistdatavariable.o \
+       DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \
+       UtilCharacter.o UtilListe.o UtilFile.o \
+       WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \
+       WorkWithlistofcoupled.o
+
+.SUFFIXES:
+.SUFFIXES: .c .o
+
+all: conv
+	@echo
+	@echo ===================================================
+	@echo   CONV is ok
+	@echo ===================================================
+	@echo
+
+#main.c: convert.y convert.lex
+#	@echo ===================================================
+#	@echo   Rebuilding main.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex main.c
+
+#fortran.c: fortran.y fortran.lex
+#	@echo ===================================================
+#	@echo   Rebuilding fortran.c ...
+#	@echo ===================================================
+#	$(MAKE) -f Makefile.lex fortran.c
+
+conv: $(OBJS)
+	$(CC) $(CFLAGS) -g $(OBJS) -o ../$@
+
+%.o: %.c
+	$(CC) $(CFLAGS) -g -c $< -o $@
+
+main.o : main.c
+fortran.o : fortran.c	
+toamr.o : toamr.c decl.h
+WriteInFile.o : WriteInFile.c decl.h
+dependfile.o : dependfile.c decl.h
+SubLoopCreation.o : SubLoopCreation.c decl.h
+WorkWithglobliste.o : WorkWithglobliste.c decl.h
+WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h
+WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h
+Writedeclarations.o : Writedeclarations.c decl.h
+UtilFortran.o : UtilFortran.c decl.h
+WorkWithParameterlist.o : WorkWithParameterlist.c decl.h
+UtilNotGridDep.o : UtilNotGridDep.c decl.h
+WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h
+DiversListe.o : DiversListe.c decl.h
+UtilAgrif.o : UtilAgrif.c decl.h
+WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h
+UtilCharacter.o : UtilCharacter.c decl.h
+UtilListe.o : UtilListe.c decl.h
+UtilFile.o : UtilFile.c decl.h
+WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h
+WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h
+WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h
+
+clean:
+#	$(MAKE) -f Makefile.lex clean
+	$(RM) *.o conv
+	
Index: vendors/AGRIF/LIB/SubLoopCreation.c
===================================================================
--- vendors/AGRIF/LIB/SubLoopCreation.c	(revision 9621)
+++ vendors/AGRIF/LIB/SubLoopCreation.c	(revision 9621)
@@ -0,0 +1,404 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+/******************************************************************************/
+/*     preparation and write of the argument list of a subroutine             */
+/******************************************************************************/
+
+
+/******************************************************************************/
+/*                           WriteBeginof_SubLoop                             */
+/******************************************************************************/
+/* We should write the head of the subroutine sub_loop_<subroutinename>       */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteBeginof_SubLoop()
+{
+   if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename);
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n");
+      /* we should add the use agrif_uti l if it is necessary                 */
+      WriteHeadofSubroutineLoop();
+      WriteUsemoduleDeclaration(subroutinename);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteIncludeDeclaration(fortran_out);
+      /*                                                                      */
+      /* We should write once the declaration of tables (extract              */
+      /*    from pointer) in the new subroutine                               */
+      if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out);
+
+      writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out);
+      WriteArgumentDeclaration_Sort(fortran_out);
+      WriteFunctionDeclaration(fortran_out, 1);
+   }
+   else
+   {
+      if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n");
+      AddUseAgrifUtil_0(fortran_out);
+      WriteUsemoduleDeclaration(subroutinename);
+      WriteIncludeDeclaration(fortran_out);
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
+      WriteArgumentDeclaration_beforecall();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1);
+/*    writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out);
+      writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/
+   }
+   if ( todebug == 1 ) printf("<   out of WriteBeginof_SubLoop\n");
+   if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename);
+}
+
+/******************************************************************************/
+/*                    WriteVariablelist_subloop                               */
+/******************************************************************************/
+/* This subroutine is used to write the list of the variable which            */
+/* should be called by the sub_loop_<name> subroutine                         */
+/* The first part is composed by the list of the local variables              */
+/******************************************************************************/
+/*                                                                            */
+/*    List_SubroutineDeclaration_Var    a,b,c,  &                             */
+/*                                      d,e,f,  &                             */
+/*     a,b,c,d,e,f,g,h     ========>    g,h                                   */
+/*                                                                            */
+/******************************************************************************/
+void WriteVariablelist_subloop(char *ligne)
+{
+   listvar *parcours;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n");
+   parcours = List_SubroutineArgument_Var;
+   didvariableadded = 0;
+
+   while ( parcours )
+   {
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subroutinename we should write the name of this variable          */
+      /*    in the output file                                                */
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+      {
+         if ( didvariableadded == 1 )   strcat(ligne,",");
+         strcat(ligne,parcours->var->v_nomvar);
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   parcours = List_FunctionType_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+      {
+         if ( didvariableadded == 1 )   strcat(ligne,",");
+         strcat(ligne,parcours->var->v_nomvar);
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop\n");
+}
+
+
+/******************************************************************************/
+/*                     WriteVariablelist_subloop_Call                         */
+/******************************************************************************/
+/* This subroutine is used to write the list of the variable which            */
+/* should be called by the sub_loop_<name> subroutine into the called         */
+/* The second part is composed by the list of the global table                */
+/******************************************************************************/
+/*                                                                            */
+/*   List_UsedInSubroutine_Var SubloopScalar = 0 | SubloopScalar = 1          */
+/*                                a,b,c,  &      |  a,b(1,1),c,      &        */
+/*     a,b,c,d,e,f,g,h  =====>    d,e,f,  &      |  d(1),e(1,1,1),f, &        */
+/*                                g,h            |  g,h(1,1)                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteVariablelist_subloop_Call(char **ligne, size_t line_length)
+{
+   listvar *parcours;
+   char ligne2[LONG_M];
+   int i;
+   size_t cur_length;
+
+   cur_length = line_length;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n");
+   parcours = List_UsedInSubroutine_Var;
+
+   while ( parcours )
+   {
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subroutinename we should write the name of this variable          */
+      /*    in the output file                                                */
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))
+         )
+      {
+         if ( didvariableadded == 1 )   strcat(*ligne,",");
+         const char *vres = vargridcurgridtabvars(parcours->var, 0);
+         if ( (strlen(*ligne)+strlen(vres)+100) > cur_length )
+         {
+            cur_length += LONG_M;
+            *ligne = realloc( *ligne, cur_length*sizeof(char) );
+         }
+         strcat(*ligne, vres);
+         /* if it is asked in the call of the conv we should give             */
+         /* scalar in argument, so we should put (1,1,1) after the            */
+         /* the name of the variable                                          */
+         if (  SubloopScalar != 0 &&
+               (
+               (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type"))) &&
+               parcours->var->v_nbdim != 0 )
+         {
+             i = 1;
+             while ( i <=  parcours->var->v_nbdim )
+             {
+                if ( i == 1 ) strcat(*ligne,"( ");
+                if ( SubloopScalar == 2 )
+                {
+                   strcat(*ligne,":");
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,",");
+                }
+                else
+                {
+                   sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i);
+                   strcat(*ligne,ligne2);
+                   if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),");
+                }
+                if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))");
+                i++;
+             }
+         }
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Call\n");
+}
+
+
+/******************************************************************************/
+/*                       WriteVariablelist_subloop_Def                        */
+/******************************************************************************/
+/* This subroutine is used to write the list of the variable which            */
+/* should be called by the sub_loop_<name> subroutine into the def            */
+/* The second part is composed by the list of the global table                */
+/* <name>_tmp                                                                 */
+/******************************************************************************/
+/*                                                                            */
+/*       List_UsedInSubroutine_Var                                            */
+/*                                a-tmp,b-tmp,c_tmp, &                        */
+/*     a,b,c,d,e,f,g,h  =====>    d_tmp,e_tmp,f_tmp, &                        */
+/*                                g_tmp,h_tmp                                 */
+/*                                                                            */
+/******************************************************************************/
+void WriteVariablelist_subloop_Def(char *ligne)
+{
+   listvar *parcours;
+
+   if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n");
+   parcours = List_UsedInSubroutine_Var;
+
+   while ( parcours )
+   {
+      /* if the readed variable is a variable of the subroutine               */
+      /*    subrotinename we should write the name of this variable           */
+      /*    in the output file                                                */
+      if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename)  &&
+           (parcours->var->v_pointerdeclare == 0 || !strcasecmp(parcours->var->v_typevar,"type")) )
+      {
+         if ( didvariableadded == 1 )   strcat(ligne,",");
+         strcat(ligne,parcours->var->v_nomvar);
+         didvariableadded = 1;
+      }
+      parcours = parcours -> suiv;
+   }
+   Save_Length(ligne,41);
+   if ( todebug == 1 ) printf("<   out of WriteVariablelist_subloop_Def\n");
+}
+
+/******************************************************************************/
+/*                      WriteHeadofSubroutineLoop                             */
+/******************************************************************************/
+/* This subroutine is used to write the head of the subroutine                */
+/* Sub_Loop_<name>                                                            */
+/******************************************************************************/
+/*                 Sub_loop_subroutine.h                                      */
+/*                                                                            */
+/*                 subroutine Sub_Loop_subroutine ( &                         */
+/*                 a,b,c, &                                                   */
+/* SubLoopScalar   d,e(1,1),f(1,1,1), &                                       */
+/*                 g,h  &                                                     */
+/*                 )                                                          */
+/******************************************************************************/
+void WriteHeadofSubroutineLoop()
+{
+   char ligne[LONG_M];
+   FILE * subloop;
+
+   if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop\n");
+   tofich(fortran_out,"\n",1);
+   /* Open this newfile                                                       */
+   sprintf(ligne,"Sub_Loop_%s.h",subroutinename);
+   subloop = open_for_write(ligne);
+   /*                                                                         */
+   if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename);
+   else             sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename);
+   /*                                                                         */
+   WriteVariablelist_subloop(ligne);
+   WriteVariablelist_subloop_Def(ligne);
+   /*                                                                         */
+   strcat(ligne,")");
+   tofich(subloop,ligne,1);
+   /* if USE agrif_Uti l should be add                                        */
+   AddUseAgrifUtil_0(subloop);
+   /*                                                                         */
+   oldfortran_out = fortran_out;
+   fortran_out = subloop;
+   if ( todebug == 1 ) printf("<   out of WriteHeadofSubroutineLoop\n");
+}
+
+/******************************************************************************/
+/*                closeandcallsubloopandincludeit_0                           */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should close the sub_loop subroutine, call it and close the             */
+/* function (suborfun = 0)                                                    */
+/* subroutine (suborfun = 1)                                                  */
+/* end (suborfun = 2)                                                         */
+/* end program (suborfun = 3)                                                 */
+/* and include the sub_loop subroutine after                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void closeandcallsubloopandincludeit_0(int suborfun)
+{
+   char *ligne;
+
+   if ( firstpass == 1 )    return;
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n");
+
+   ligne = (char*) calloc(LONG_M, sizeof(char));
+
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should remove the key word end subroutine                         */
+      RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine);
+      /* We should close the loop subroutine                                  */
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
+      WriteArgumentDeclaration_beforecall();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
+      if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
+            fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
+      /* Now we add the call af the new subroutine                            */
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
+      /* Write the list of the local variables used in this new subroutine    */
+      WriteVariablelist_subloop(ligne);
+      /* Write the list of the global tables used in this new subroutine      */
+      /*    in doloop                                                         */
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
+      /* Close the parenthesis of the new subroutine called                   */
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
+      /* we should include the above file in the original code                */
+
+      /* We should close the original subroutine                              */
+      if ( suborfun == 3 ) fprintf(fortran_out, "      end program %s\n"   , subroutinename);
+      if ( suborfun == 2 ) fprintf(fortran_out, "      end\n");
+      if ( suborfun == 1 ) fprintf(fortran_out, "      end subroutine %s\n", subroutinename);
+      if ( suborfun == 0 ) fprintf(fortran_out, "      end function %s\n"  , subroutinename);
+
+      fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename);
+    }
+    oldfortran_out = (FILE *)NULL;
+    if ( todebug == 1 ) printf("<   out of closeandcallsubloopandincludeit_0\n");
+}
+
+void closeandcallsubloop_contains_0()
+{
+   char *ligne;
+
+   if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n");
+   if ( IsTabvarsUseInArgument_0() == 1 )
+   {
+      ligne = (char*) calloc(LONG_M, sizeof(char));
+      RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename);
+      tofich(fortran_out,ligne,1);
+      fclose(fortran_out);
+      fortran_out = oldfortran_out;
+
+      AddUseAgrifUtilBeforeCall_0(fortran_out);
+
+      if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, "      implicit none\n");
+      WriteLocalParamDeclaration(fortran_out);
+      WriteArgumentDeclaration_beforecall();
+      if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0);
+/*      WriteSubroutineDeclaration(0);*/
+      if ( !strcasecmp(subofagrifinitgrids,subroutinename) )
+          fprintf(fortran_out,"      call Agrif_Init_Grids()\n");
+      /* Now we add the call af the new subroutine                            */
+      tofich(fortran_out,"\n",1);
+      sprintf(ligne,"  call Sub_Loop_%s(",subroutinename);
+      /* Write the list of the local variables used in this new subroutine    */
+      WriteVariablelist_subloop(ligne);
+      /* Write the list of the global tables used in this new subroutine      */
+      /*    in doloop                                                         */
+      WriteVariablelist_subloop_Call(&ligne, LONG_M);
+      /* Close the parenthesis of the new subroutine called                   */
+      strcat(ligne,")\n");
+      tofich(fortran_out,ligne,1);
+      /* We should close the original subroutine                              */
+      fprintf(fortran_out, "      contains\n");
+      /* we should include the above file in the original code                */
+      fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename);
+      }
+   oldfortran_out = (FILE *)NULL;
+   if ( todebug == 1 ) printf("<   out of closeandcallsubloop_contains_0\n");
+}
Index: vendors/AGRIF/LIB/UtilAgrif.c
===================================================================
--- vendors/AGRIF/LIB/UtilAgrif.c	(revision 9621)
+++ vendors/AGRIF/LIB/UtilAgrif.c	(revision 9621)
@@ -0,0 +1,838 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+/******************************************************************************/
+/*                      Vartonumber                                           */
+/******************************************************************************/
+/* This subroutine is used to know if Agrif_ is locate in the char            */
+/* tokname                                                                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int Vartonumber(const char *tokname)
+{
+   int agrifintheword;
+
+   agrifintheword = 0;
+        if ( !strcasecmp(tokname,"Agrif_parent")         ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_type")       ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_raf")        ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_bc")         ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_bcinterp")   ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Root")           ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_CFixed")         ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Fixed")          ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_bc_variable")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_set_parent")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_interp_variable")) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_init_variable")  ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_update_variable")) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_interp")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_Update")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Set_restore")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_init_grids")     ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_step")           ) agrifintheword = 1;
+/**************************************************/
+/* adding specific adjoint agrif subroutine names */
+/**************************************************/
+   else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj")    ) agrifintheword = 1;
+   else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1;
+
+   return agrifintheword;
+}
+
+/******************************************************************************/
+/*                              Agrif_in_Tok_NAME                             */
+/******************************************************************************/
+/* This subroutine is used to know if Agrif_ is locate in the char            */
+/* tokname                                                                    */
+/******************************************************************************/
+/*                                                                            */
+/*                 Agrif_name --------------> Agrif_in_Tok_NAME = 1           */
+/*                       name --------------> Agrif_in_Tok_NAME = 0           */
+/*                                                                            */
+/******************************************************************************/
+int Agrif_in_Tok_NAME(const char *tokname)
+{
+    return ( strncasecmp(tokname,"Agrif_",6) == 0 );
+}
+
+/******************************************************************************/
+/*                     ModifyTheVariableName_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheVariableName_0(const char *ident, int lengthname)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass )  return;
+
+    newvar = List_Global_Var;
+    out = 0;
+    while ( newvar && out == 0 )
+    {
+        if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1;
+        else newvar = newvar->suiv;
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return;
+
+    if ( out == 0 )
+    {
+        newvar = List_Common_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 0 )
+    {
+        newvar = List_ModuleUsedInModuleUsed_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+    }
+    if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type"))
+    {
+        // remove the variable
+        RemoveWordCUR_0(fortran_out,lengthname);
+        // then write the new name
+        if ( inagrifcallargument == 1 && agrif_parentcall == 0 )
+            fprintf(fortran_out,"%d",newvar->var->v_indicetabvars);
+        else
+        {
+            if ( retour77 == 0 )
+                fprintf(fortran_out,"Agrif_%s & \n      ", tabvarsname(newvar->var));
+            else
+            {
+               fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var));
+               fprintf(fortran_out," \n     & ");
+            }
+            fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+        }
+    }
+    else
+    {
+        // we should look in the List_ModuleUsed_Var
+        if ( inagrifcallargument != 1 )
+        {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+            if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type"))
+            {
+                // remove the variable
+                RemoveWordCUR_0(fortran_out,lengthname);
+                // then write the new name
+                if ( retour77 == 0 )
+                    fprintf(fortran_out,"Agrif_%s & \n      ",tabvarsname(newvar->var));
+                else
+                {
+                    fprintf(fortran_out," \n     &Agrif_%s",tabvarsname(newvar->var));
+                }
+                fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var));
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                         Add_SubroutineWhereAgrifUsed_1                     */
+/******************************************************************************/
+/* This subroutine is used to add a record to                                 */
+/* List_SubroutineWhereAgrifUsed                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... Agrif_<something>                                 */
+/*                                                                            */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + list +--->+ list +--->+ list +--->+ list +--->+ sub  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list = List_SubroutineWhereAgrifUsed                                 */
+/*                                                                            */
+/******************************************************************************/
+void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod)
+{
+    listnom *listnomtmp;
+    listnom *parcours;
+
+    if ( firstpass == 1 )
+    {
+        if ( !List_SubroutineWhereAgrifUsed )
+        {
+            listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+            strcpy(listnomtmp->o_nom, sub);
+            strcpy(listnomtmp->o_module, mod);
+            listnomtmp->suiv = NULL;
+            List_SubroutineWhereAgrifUsed = listnomtmp;
+        }
+        else
+        {
+            parcours = List_SubroutineWhereAgrifUsed;
+            while ( parcours && strcasecmp(parcours->o_nom,sub) )
+            {
+                parcours = parcours->suiv;
+            }
+            if ( !parcours )
+            {
+                listnomtmp = (listnom*) calloc(1, sizeof(listnom));
+                strcpy(listnomtmp->o_nom, sub);
+                strcpy(listnomtmp->o_module, mod);
+                listnomtmp->suiv = List_SubroutineWhereAgrifUsed;
+                List_SubroutineWhereAgrifUsed = listnomtmp;
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                                AddUseAgrifUtil_0                           */
+/******************************************************************************/
+/* Add use Agrif_Util at the beginning of the subroutine definition           */
+/* if it is necessary                                                         */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub            |  subroutine sub                          */
+/*                                 |  USE Agrif_Util                          */
+/*       implicit none             |  implicit none                           */
+/*       ...                       |  ...                                     */
+/*       ... Agrif_<something>     |  ... Agrif_<something>                   */
+/*       ...                       |  ...                                     */
+/*       end                       |  end                                     */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void  AddUseAgrifUtil_0(FILE *fileout)
+{
+  listnom *parcours;
+
+  if ( firstpass == 0 )
+  {
+     parcours = List_SubroutineWhereAgrifUsed;
+     while ( parcours && strcasecmp(parcours->o_nom,subroutinename) )
+     {
+        parcours = parcours -> suiv;
+     }
+     if ( parcours && parcours->o_val != 0 )
+        fprintf(fileout,"\n      use Agrif_Util\n");
+     else
+        fprintf(fileout,"\n      use Agrif_Types, only : Agrif_tabvars\n");
+  }
+}
+
+void  AddUseAgrifUtilBeforeCall_0(FILE *fileout)
+{
+    listusemodule *parcours;
+
+    int out;
+
+    if ( firstpass == 0 )
+    {
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util")   &&
+                 !strcasecmp(parcours->u_modulename, curmodulename) &&
+                 !strcasecmp(parcours->u_cursubroutine, subroutinename) )
+                out = 1;
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            fprintf(fileout,"\n      use Agrif_Util\n");
+        }
+    }
+}
+
+/******************************************************************************/
+/*                         NotifyAgrifFunction_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void NotifyAgrifFunction_0(const char *ident)
+{
+    if ( firstpass == 1 )   return;
+
+    if ( !strcasecmp(ident,"Agrif_parent") )
+    {
+        InAgrifParentDef = 1;
+        pos_curagrifparent = setposcur()-12;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") )
+    {
+        InAgrifParentDef = 2;
+        pos_curagrifparent = setposcur()-21;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhox") )
+    {
+        InAgrifParentDef = 3;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") )
+    {
+        InAgrifParentDef = 4;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhox") )
+    {
+        InAgrifParentDef = 5;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") )
+    {
+        InAgrifParentDef = 6;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoy") )
+    {
+        InAgrifParentDef = 7;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") )
+    {
+        InAgrifParentDef = 8;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoy") )
+    {
+        InAgrifParentDef = 9;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") )
+    {
+        InAgrifParentDef = 10;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Rhoz") )
+    {
+        InAgrifParentDef = 11;
+        pos_curagrifparent = setposcur()-10;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") )
+    {
+        InAgrifParentDef = 12;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_IRhoz") )
+    {
+        InAgrifParentDef = 13;
+        pos_curagrifparent = setposcur()-11;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") )
+    {
+        InAgrifParentDef = 14;
+        pos_curagrifparent = setposcur()-18;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") )
+    {
+        InAgrifParentDef = 15;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") )
+    {
+        InAgrifParentDef = 16;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") )
+    {
+        InAgrifParentDef = 17;
+        pos_curagrifparent = setposcur()-23;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") )
+    {
+        InAgrifParentDef = 18;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") )
+    {
+        InAgrifParentDef = 19;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") )
+    {
+        InAgrifParentDef = 20;
+        pos_curagrifparent = setposcur()-26;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_parent_id") )
+    {
+        InAgrifParentDef = 21;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Get_grid_id") )
+    {
+        InAgrifParentDef = 22;
+        pos_curagrifparent = setposcur()-17;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iz") )
+    {
+        InAgrifParentDef = 23;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Iy") )
+    {
+        InAgrifParentDef = 24;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Parent_Ix") )
+    {
+        InAgrifParentDef = 25;
+        pos_curagrifparent = setposcur()-15;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iz") )
+    {
+        InAgrifParentDef = 26;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Iy") )
+    {
+        InAgrifParentDef = 27;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Ix") )
+    {
+        InAgrifParentDef = 28;
+        pos_curagrifparent = setposcur()-8;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-20;
+    }
+    else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") )
+    {
+        InAgrifParentDef = 29;
+        pos_curagrifparent = setposcur()-19;
+    }
+    else if ( !strcasecmp(ident,"AGRIF_Nb_Step") )
+    {
+        InAgrifParentDef = 30;
+        pos_curagrifparent = setposcur()-13;
+    }
+}
+
+/******************************************************************************/
+/*                       ModifyTheAgrifFunction_0                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void ModifyTheAgrifFunction_0(const char *ident)
+{
+   if ( InAgrifParentDef != 0 )
+          AgriffunctionModify_0(ident,InAgrifParentDef);
+   InAgrifParentDef = 0;
+}
+
+
+/******************************************************************************/
+/*                         AgriffunctionModify_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/* if whichone = 1 Agrif_parent ===>                                          */
+/*                                                                            */
+/* if whichone = 2 Agrif_Get_coarse_grid ===>                                 */
+/*                                                                            */
+/* if whichone = 3 Agrif_Rhox ===>                                            */
+/*                                                                            */
+/* if whichone = 4 Agrif_Parent_Rhox ===>                                     */
+/*                                                                            */
+/* if whichone = 5 Agrif_IRhox ===>                                           */
+/*                                                                            */
+/* if whichone = 6 Agrif_Parent_IRhox ===>                                    */
+/*                                                                            */
+/* if whichone = 7 Agrif_Rhoy ===>                                            */
+/*                                                                            */
+/* if whichone = 8 Agrif_Parent_Rhoy ===>                                     */
+/*                                                                            */
+/* if whichone = 9 Agrif_IRhoy ===>                                           */
+/*                                                                            */
+/* if whichone = 10 Agrif_Parent_IRhoy ===>                                   */
+/*                                                                            */
+/* if whichone = 11 Agrif_Rhoz ===>                                           */
+/*                                                                            */
+/* if whichone = 12 Agrif_Parent_Rhoz ===>                                    */
+/*                                                                            */
+/* if whichone = 13 Agrif_IRhoz ===>                                          */
+/*                                                                            */
+/* if whichone = 14 Agrif_Parent_IRhoz ===>                                   */
+/*                                                                            */
+/* if whichone = 15 Agrif_NearCommonBorderX ===>                              */
+/*                                                                            */
+/* if whichone = 16 Agrif_NearCommonBorderX ===>                              */
+/*                                                                            */
+/* if whichone = 17 Agrif_NearCommonBorderX ===>                              */
+/*                                                                            */
+/* if whichone = 18 Agrif_DistantCommonBorderX ===>                           */
+/*                                                                            */
+/* if whichone = 19 Agrif_DistantCommonBorderY ===>                           */
+/*                                                                            */
+/* if whichone = 20 Agrif_DistantCommonBorderZ ===>                           */
+/*                                                                            */
+/* if whichone = 21 Agrif_Get_parent_id ===>                                  */
+/*                                                                            */
+/* if whichone = 22 Agrif_Get_grid_id ===>                                    */
+/*                                                                            */
+/* if whichone = 23 Agrif_Parent_Iz ===>                                      */
+/*                                                                            */
+/* if whichone = 24 Agrif_Parent_Iy ===>                                      */
+/*                                                                            */
+/* if whichone = 25 Agrif_Parent_Ix ===>                                      */
+/*                                                                            */
+/* if whichone = 26 Agrif_Iz ===>                                             */
+/*                                                                            */
+/* if whichone = 27 Agrif_Iy ===>                                             */
+/*                                                                            */
+/* if whichone = 28 Agrif_Ix ===>                                             */
+/*                                                                            */
+/* if whichone = 29 Agrif_Nb_Fixed_Grids ===>                                 */
+/*                                                                            */
+/* if whichone = 29 Agrif_Nb_Fine_Grids ===>                                  */
+/*                                                                            */
+/* if whichone = 30 AGRIF_Nb_Step ===>                                        */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void AgriffunctionModify_0(const char *ident,int whichone)
+{
+    char toprint[LONG_M];
+    if ( firstpass == 0 )
+    {
+        strcpy(toprint,"");
+        pos_end = setposcur();
+        fseek(fortran_out,pos_curagrifparent,SEEK_SET);
+        if ( whichone == 1 || whichone == 2 )
+        {
+            FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1);
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone);
+            }
+            if ( !strcasecmp(ident,toprint) )
+            {
+                /* la liste des use de cette subroutine                           */
+                strcpy(toprint,"");
+                FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone);
+            }
+        }
+        else if ( whichone == 3 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % spaceref(1))");
+        }
+        else if ( whichone == 4 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"REAL(");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))");
+        }
+        else if ( whichone == 5 ) /* Agrif_Rhox                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(1)");
+        }
+        else if ( whichone == 6 ) /* Agrif_Parent_Rhox                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(1)");
+        }
+        else if ( whichone == 7 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2))");
+        }
+        else if ( whichone == 8 ) /* Agrif_Parent_Rhoy                          */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2))");
+        }
+        else if ( whichone == 9 ) /* Agrif_Rhoy                                 */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(2)");
+        }
+        else if ( whichone == 10 ) /* Agrif_Parent_Rhoy                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(2)");
+        }
+        else if ( whichone == 11 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3))");
+        }
+        else if ( whichone == 12 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"REAL(Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3))");
+        }
+        else if ( whichone == 13 ) /* Agrif_Rhoz                                */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% spaceref(3)");
+        }
+        else if ( whichone == 14 ) /* Agrif_Parent_Rhoz                         */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % spaceref(3)");
+        }
+        else if ( whichone == 15 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(1)");
+        }
+        else if ( whichone == 16 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(2)");
+        }
+        else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% NearRootBorder(3)");
+        }
+        else if ( whichone == 18 ) /* Agrif_NearCommonBorderX                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+         strcat(toprint,"% DistantRootBorder(1)");
+        }
+        else if ( whichone == 19 ) /* Agrif_NearCommonBorderY                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(2)");
+        }
+        else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ                   */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% DistantRootBorder(3)");
+        }
+        else if ( whichone == 21 ) /* Agrif_Get_parent_id                       */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % grid_id");
+        }
+        else if ( whichone == 22 ) /*  Agrif_Get_grid_id                        */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% grid_id");
+        }
+        else if ( whichone == 23 ) /*  Agrif_Parent_Iz                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(3)");
+        }
+        else if ( whichone == 24 ) /*  Agrif_Parent_Iy                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(2)");
+        }
+        else if ( whichone == 25 ) /*  Agrif_Parent_Ix                          */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% parent % ix(1)");
+        }
+        else if ( whichone == 26 ) /* Agrif_Iz                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint," % ix(3)");
+        }
+        else if ( whichone == 27 ) /* Agrif_Iy                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(2)");
+        }
+        else if ( whichone == 28 ) /* Agrif_Ix                                  */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ix(1)");
+        }
+        else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids                      */
+        {
+            sprintf(toprint,"Agrif_nbfixedgrids");
+        }
+        else if ( whichone == 30 ) /* AGRIF_Nb_Step                             */
+        {
+            sprintf(toprint,"Agrif_Curgrid");
+            if( retour77 == 0 ) strcat(toprint," & \n");
+            else                strcat(toprint,"\n     & ");
+            strcat(toprint,"% ngridstep");
+        }
+
+        Save_Length(toprint,43);
+
+        if ( whichone == 1 || whichone == 2 )   tofich(fortran_out,toprint,0);
+        else                                    fprintf(fortran_out,"%s",toprint);
+    }
+}
+
+/******************************************************************************/
+/*                             Instanciation_0                                */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void Instanciation_0(const char *ident)
+{
+    listvar *newvar;
+    int out;
+
+    if ( firstpass == 0 && sameagrifargument == 1 )
+    {
+        newvar = List_Global_Var;
+        out = 0;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+            else newvar = newvar->suiv;
+        }
+        if ( out == 0 )
+        {
+            newvar = List_Common_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+        if ( out == 0 )
+        {
+            newvar = List_ModuleUsed_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1;
+                else newvar = newvar->suiv;
+            }
+        }
+//         if ( out == 1 )
+//         {
+//             /* then write the instanciation                                      */
+//             fprintf(fortran_out,"\n      %s = %s",ident,vargridcurgridtabvars(newvar->var,3));
+//             printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3));
+//         }
+    }
+    sameagrifargument = 0;
+}
Index: vendors/AGRIF/LIB/UtilCharacter.c
===================================================================
--- vendors/AGRIF/LIB/UtilCharacter.c	(revision 9621)
+++ vendors/AGRIF/LIB/UtilCharacter.c	(revision 9621)
@@ -0,0 +1,387 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+
+
+/******************************************************************************/
+/*                         FindAndChangeNameToTabvars                         */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/* if  whichone = 0 ----> Agrif_tabvars(i) % array2                           */
+/*                                                                            */
+/* if  whichone = 1 ----> Agrif_tabvars(i) % parentvar % array2               */
+/*                                                                            */
+/******************************************************************************/
+void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
+                                              listvar * listtosee, int whichone)
+{
+   listvar *newvar;
+   int out;
+   
+
+   if ( strcasecmp(name,"") )
+   {
+      newvar=listtosee;
+      out=0;
+      while( newvar && out == 0 )
+      {
+         if ( !strcasecmp(newvar->var->v_nomvar,name) )
+         {
+
+            if ( LookingForVariableInListName(
+                             List_SubroutineArgument_Var,name) == 0 )
+            {
+               out = 1;
+               strcat(toprint,vargridcurgridtabvars(newvar->var, whichone));
+            }
+            else newvar=newvar->suiv;
+         }
+         else newvar=newvar->suiv;
+      }
+      if ( out == 0 ) strcat(toprint,name);
+   }
+   Save_Length(toprint,44);
+}
+
+
+/******************************************************************************/
+/*                     ChangeTheInitalvaluebyTabvarsName                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+const char *ChangeTheInitalvaluebyTabvarsName(const char *nom, listvar *listtoread)
+{
+    char toprinttmp[LONG_M];
+    char chartmp[2];
+    size_t i = 0;
+
+    strcpy(toprintglob, "");
+    strcpy(toprinttmp,  "");
+
+    while ( i < strlen(nom) )
+    {
+        if ( (nom[i] == '+') || (nom[i] == '-') || (nom[i] == '*') || (nom[i] == '/') ||
+             (nom[i] == '(') || (nom[i] == ')') || (nom[i] == ':') || (nom[i] == ',') )
+        {
+            FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+            strcpy(toprinttmp, "");
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprintglob, chartmp);
+        }
+        else
+        {
+            sprintf(chartmp, "%c", nom[i]);
+            strcat(toprinttmp, chartmp);
+        }
+        i += 1;
+    }
+    FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0);
+    strcpy(toprinttmp,"");
+
+    Save_Length(toprinttmp,44);
+    Save_Length(toprintglob,39);
+
+    return toprintglob;
+}
+
+/******************************************************************************/
+/*                            IsVariableReal                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int IsVariableReal(const char *nom)
+{
+    return ( ( nom[0] >= 'a' && nom[0] <= 'h' ) ||
+        ( nom[0] >= 'A' && nom[0] <= 'H' ) ||
+        ( nom[0] >= 'o' && nom[0] <= 'z' ) ||
+        ( nom[0] >= 'O' && nom[0] <= 'Z' ) );
+}
+/******************************************************************************/
+/*                         IsVarInUseFile                                     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void IsVarInUseFile(const char *nom)
+{
+   listvar *parcours;
+   listparameter *parcoursparam;
+   int out;
+
+   out = 0;
+
+   parcours = List_Global_Var;
+   while( parcours && out == 0 )
+   {
+      if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+     else parcours=parcours->suiv;
+   }
+   if ( out == 0 )
+   {
+      parcours = List_Common_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_GlobalParameter_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_Parameter_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcoursparam = List_GlobParamModuleUsed_Var;
+      while( parcoursparam && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 2 ;
+         else parcoursparam=parcoursparam->suiv;
+      }
+   }
+   if ( out == 0 )
+   {
+      parcours = List_ModuleUsed_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 2 ;
+        else parcours=parcours->suiv;
+      }
+   }
+   if ( out == 0 || out == 2 )
+   {
+      parcoursparam = List_GlobParamModuleUsedInModuleUsed_Var;
+      while( parcoursparam && out != 1 )
+      {
+         if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 1 ;
+         else parcoursparam=parcoursparam->suiv;
+      }
+      if ( out == 1 )
+      {
+         strcpy(charusemodule,parcoursparam->p_modulename);
+         Addmoduletothelist(parcoursparam->p_modulename);
+      }
+   }
+   if ( out == 0 &&
+        strcasecmp(nom,"MAX")             &&
+        strcasecmp(nom,"mpi_status_size")
+      )
+   {
+   /*   printf("--- in UtilCharacter we do not found the \n");
+      printf("---  variable %s, the module where this \n",nom);
+      printf("---  variable has been defined has not been\n");
+      printf("---  found.\n");*/
+   }
+}
+
+/******************************************************************************/
+/*                      DecomposeTheNameinlistnom                             */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout)
+{
+   char toprinttmp[LONG_M];
+   char chartmp[2];
+   size_t i = 0;
+
+   strcpy(toprinttmp,"");
+
+   while ( i < strlen(nom) )
+   {
+      if ( nom[i] == '+' ||
+           nom[i] == '-' ||
+           nom[i] == '*' ||
+           nom[i] == '/' ||
+           nom[i] == ')' ||
+           nom[i] == '(' ||
+           nom[i] == ',' ||
+           nom[i] == ':'
+         )
+      {
+         if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+         {
+             listout = Addtolistnom(toprinttmp,listout,0);
+         }
+         strcpy(toprinttmp,"");
+      }
+      else
+      {
+         sprintf(chartmp,"%c",nom[i]);
+         strcat(toprinttmp,chartmp);
+      }
+      i=i+1;
+   }
+   if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+   {
+      listout = Addtolistnom(toprinttmp,listout,0);
+   }
+   Save_Length(toprinttmp,44);
+   strcpy(toprinttmp,"");
+
+   return listout;
+}
+
+
+/******************************************************************************/
+/*                      DecomposeTheName                                      */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+void DecomposeTheName(const char *nom)
+{
+   char toprinttmp[LONG_M];
+   char chartmp[2];
+   size_t i = 0;
+   
+   strcpy(toprinttmp,"");
+
+   while ( i < strlen(nom) )
+   {
+      if ( nom[i] == '+' ||
+           nom[i] == '-' ||
+           nom[i] == '*' ||
+           nom[i] == '/' ||
+           nom[i] == ')' ||
+           nom[i] == '(' ||
+           nom[i] == ',' ||
+           nom[i] == ':'
+         )
+      {
+         if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+         {
+            ajoutevarindoloop_definedimension (toprinttmp);
+            /* Is this variable present in globvarofusefile                   */
+            IsVarInUseFile(toprinttmp);
+         }
+         strcpy(toprinttmp,"");
+      }
+      else
+      {
+         sprintf(chartmp,"%c",nom[i]);
+         strcat(toprinttmp,chartmp);
+      }
+      i=i+1;
+   }
+   if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) )
+   {
+      ajoutevarindoloop_definedimension (toprinttmp);
+      /* Is this variable present in globvarofusefile                         */
+      IsVarInUseFile(toprinttmp);
+   }
+   Save_Length(toprinttmp,44);
+   strcpy(toprinttmp,"");
+
+}
+
+void convert2lower(char *lowername, const char* inputname)
+{
+    int i, l, caractere;
+
+    strcpy(lowername, inputname);
+    l = strlen(lowername)-1;
+
+    for ( i=0 ; i<=l ; i++)
+    {
+        caractere = lowername[i];
+        if ( (caractere>=65 && caractere<=90) || (caractere>=192 && caractere<=221) )
+        {
+            lowername[i] += 32;
+        }
+    }
+}
+
+int convert2int(const char *name)
+{
+   int i;
+   int caractere;
+   int value;
+   int value_tmp;
+   int longueur;
+
+   value = 0;
+
+   longueur = strlen(name) - 1;
+   for (i=0;i<=longueur;i++)
+   {
+      caractere=name[i];
+      value_tmp = caractere -'0';
+      if ( value_tmp > 9 ) return 0;
+           if ( longueur+1-i == 6 ) value = value + value_tmp *100000;
+      else if ( longueur+1-i == 5 ) value = value + value_tmp *10000;
+      else if ( longueur+1-i == 4 ) value = value + value_tmp *1000;
+      else if ( longueur+1-i == 3 ) value = value + value_tmp *100;
+      else if ( longueur+1-i == 2 ) value = value + value_tmp *10;
+      else if ( longueur+1-i == 1 ) value = value + value_tmp *1;
+   }
+   return value;
+}
Index: vendors/AGRIF/LIB/UtilFile.c
===================================================================
--- vendors/AGRIF/LIB/UtilFile.c	(revision 9621)
+++ vendors/AGRIF/LIB/UtilFile.c	(revision 9621)
@@ -0,0 +1,128 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+/******************************************************************************/
+/*                         open_for_write                                     */
+/******************************************************************************/
+/* This subroutine is used to open a file                                     */
+/******************************************************************************/
+FILE* open_for_write (const char *filename)
+{
+    char filefich[LONG_FNAME];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "w");
+}
+
+/******************************************************************************/
+/*                          open_for_append                                   */
+/******************************************************************************/
+/* This subroutine is used to open a file with option a+                      */
+/******************************************************************************/
+FILE* open_for_append (const char *filename)
+{
+    char filefich[LONG_M];
+    sprintf(filefich,"%s/%s",include_dir,filename);
+    return fopen(filefich, "a+");
+}
+
+/******************************************************************************/
+/*                           setposcurname                                    */
+/******************************************************************************/
+/* This subroutine is used to know the current position in the file in argument    */
+/******************************************************************************/
+/*                                                                            */
+/*                      setposcur ---------> position in file                 */
+/*                                                                            */
+/******************************************************************************/
+long int setposcurname(FILE *fileout)
+{
+    fflush(fileout);
+    return ftell(fileout);
+}
+
+/******************************************************************************/
+/*                           setposcur                                        */
+/******************************************************************************/
+/* This subroutine is used to know the current position in the file           */
+/******************************************************************************/
+/*                                                                            */
+/*                      setposcur ---------> position in file                 */
+/*                                                                            */
+/******************************************************************************/
+long int setposcur()
+{
+    return setposcurname(fortran_out);
+}
+
+/******************************************************************************/
+/*                         copyuse_0                                          */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write in the fortran_out the USE tok_name                         */
+/* read in the original file                                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void copyuse_0(const char *namemodule)
+{
+    if ( IsTabvarsUseInArgument_0() == 1 )
+    {
+        /* We should write this declaration into the original subroutine too    */
+        fprintf(oldfortran_out,"      use %s\n", namemodule);
+    }
+}
+
+/******************************************************************************/
+/*                         copyuseonly_0                                      */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/* We should write in the fortran_out the USE tok_name, only                   */
+/* read in the original file                                                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void copyuseonly_0(const char *namemodule)
+{
+   if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 )
+   {
+      /* We should write this declaration into the original subroutine too    */
+      fprintf(oldfortran_out,"      use %s , only : \n", namemodule);
+   }
+}
Index: vendors/AGRIF/LIB/UtilFortran.c
===================================================================
--- vendors/AGRIF/LIB/UtilFortran.c	(revision 9621)
+++ vendors/AGRIF/LIB/UtilFortran.c	(revision 9621)
@@ -0,0 +1,635 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                            initdimprob                                     */
+/******************************************************************************/
+/* This subroutine is used to initialized grid dimension variable             */
+/******************************************************************************/
+void initdimprob(int dimprobmod, const char * nx, const char * ny, const char* nz)
+{
+    dimprob = dimprobmod;
+
+    strcpy(nbmaillesX, nx);
+    strcpy(nbmaillesY, ny);
+    strcpy(nbmaillesZ, nz);
+}
+
+/******************************************************************************/
+/*                      Variableshouldberemoved                               */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
+/*                                                                            */
+/******************************************************************************/
+int Variableshouldberemoved(const char *nom)
+{
+    return Agrif_in_Tok_NAME(nom);
+}
+
+/******************************************************************************/
+/*                          variableisglobal                                  */
+/******************************************************************************/
+/* This subroutine is to know if a variable is global                         */
+/******************************************************************************/
+int variableisglobal(listvar *curvar, listvar *listin)
+{
+  int Globalite;
+  listvar *newvar;
+
+
+  Globalite = 0;
+  newvar = listin;
+  while ( newvar && Globalite == 0 )
+  {
+     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
+     {
+        Globalite = 1;
+        /* Now we should give the definition of the variable in the           */
+        /* table List_UsedInSubroutine_Var                                    */
+        strcpy(curvar->var->v_typevar, newvar->var->v_typevar);
+        strcpy(curvar->var->v_dimchar, newvar->var->v_dimchar);
+        curvar->var->v_nbdim          = newvar->var->v_nbdim;
+        curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven;
+        curvar->var->v_allocatable    = newvar->var->v_allocatable;
+        curvar->var->v_target         = newvar->var->v_target;
+        curvar->var->v_catvar         = newvar->var->v_catvar;
+        curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare;
+        curvar->var->v_indicetabvars  = newvar->var->v_indicetabvars;
+        strcpy(curvar->var->v_nameinttypename, newvar->var->v_nameinttypename);
+        strcpy(curvar->var->v_precision, newvar->var->v_precision);
+        strcpy(curvar->var->v_readedlistdimension, newvar->var->v_readedlistdimension);
+        strcpy(curvar->var->v_commoninfile, newvar->var->v_commoninfile);
+     }
+     else
+     {
+         newvar = newvar->suiv;
+     }
+  }
+
+  return Globalite ;
+}
+
+int VariableIsInListCommon(listvar *curvar,listvar *listin)
+{
+  int present;
+  listvar *newvar;
+
+  present = 0;
+  newvar = listin;
+
+  while ( newvar && present == 0 )
+  {
+     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) &&
+          !strcasecmp(newvar->var->v_subroutinename, curvar->var->v_subroutinename) )
+     {
+        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
+        Merge_Variables(curvar->var,newvar->var);
+        present = 1;
+     }
+     else newvar = newvar->suiv;
+  }
+
+  return present;
+}
+
+int VariableIsInList(listvar *curvar,listvar *listin)
+{
+  int present;
+  listvar *newvar;
+
+  present = 0;
+  newvar = listin;
+  while ( newvar && present == 0 )
+  {
+     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
+     {
+        Merge_Variables(curvar->var,newvar->var);
+        present = 1;
+     }
+     else newvar = newvar->suiv;
+  }
+
+  return present;
+}
+
+/******************************************************************************/
+/*                      variableisglobalinmodule                              */
+/******************************************************************************/
+/* This subroutine is to know if a variable is global                         */
+/******************************************************************************/
+void variableisglobalinmodule(listcouple *listin, const char *module, FILE *fileout, long int oldposcuruse)
+{
+  int Globalite;
+  listcouple *newvar;
+  listcouple *newvarprec;
+  listvar *tempo;
+  listvar *newvar2;
+  int out;
+  char truename[LONG_VNAME];
+
+  Globalite = 1;
+  newvarprec = (listcouple *)NULL;
+  tempo = (listvar *)NULL;
+  tempo = Readthedependfile(module,tempo);
+  newvar = listin;
+
+  while ( newvar )
+  {
+     if (!strcmp(newvar->c_namepointedvar,"")) {
+       strcpy(truename,newvar->c_namevar);
+     }
+     else
+     {
+       strcpy(truename,newvar->c_namepointedvar);
+     }
+
+     out = 0;
+     newvar2 = tempo;
+     while ( newvar2 && out == 0 )
+     {
+        if ( !strcasecmp(newvar2->var->v_nomvar,truename) ) out = 1;
+        else newvar2 = newvar2 ->suiv;
+     }
+     if ( out == 1 )
+     {
+        /* remove from the listin                                             */
+        if ( newvar == listin )
+        {
+           listin = listin->suiv;
+           newvar = listin;
+        }
+        else
+        {
+           newvarprec->suiv = newvar->suiv;
+           newvar = newvar->suiv;
+        }
+     }
+     else
+     {
+         newvarprec = newvar;
+         newvar = newvar->suiv;
+         Globalite = 0;
+     }
+  }
+  if ( Globalite == 0 || !newvar)
+  {
+     pos_end = setposcurname(fileout);
+     RemoveWordSET_0(fileout,oldposcuruse,pos_end-oldposcuruse);
+
+     newvar = listin;
+     while ( newvar )
+     {
+        fprintf(fileout,"      use %s, only : %s \n",module,newvar->c_namevar);
+        newvar = newvar->suiv;
+     }
+  }
+}
+
+void Write_Word_end_module_0()
+{
+    if ( firstpass == 0 )
+    {
+        fprintf(fortran_out,"\n      end module %s",curmodulename);
+    }
+}
+
+void Add_Subroutine_For_Alloc(const char *nom)
+{
+   listnom *parcours;
+   listnom *newvar;
+   int out;
+
+   newvar = (listnom*) calloc(1, sizeof(listnom));
+   strcpy(newvar->o_nom,nom);
+   newvar->suiv = NULL;
+
+   if ( !List_Subroutine_For_Alloc )
+   {
+      List_Subroutine_For_Alloc = newvar;
+   }
+   else
+   {
+      parcours = List_Subroutine_For_Alloc;
+      out = 0 ;
+      while ( parcours->suiv && out == 0 )
+      {
+         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
+         else parcours = parcours ->suiv;
+      }
+      /*                                                                      */
+      if ( out == 0 )
+      {
+         if ( strcasecmp(parcours->o_nom,nom) ) parcours->suiv = newvar;
+      }
+   }
+}
+
+void Write_Closing_Module(int forend)
+{
+    listvar *parcours;
+    listnom *parcours_nom;
+    listnom *parcours_nomprec;
+    variable *v;
+    int out = 0;
+    int headtypewritten = 0;
+    char ligne[LONG_M];
+    int changeval;
+
+    // Write Global Parameter Declaration
+    parcours = List_GlobalParameter_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename, curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, module_declar, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Global Type declaration
+    parcours = List_Global_Var;
+    while( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_modulename, curmodulename) &&
+             !strcasecmp(v->v_typevar, "type") )
+        {
+            if ( headtypewritten == 0 )
+            {
+                fprintf(fortran_out, "\n      type Agrif_%s\n", curmodulename);
+                headtypewritten = 1;
+            }
+            changeval = 0;
+            if ( v->v_allocatable )
+            {
+                changeval = 1;
+                v->v_allocatable = 0;
+                v->v_pointerdeclare = 1;
+            }
+            WriteVarDeclaration(v, fortran_out, 0, 0);
+            if ( changeval )
+            {
+                v->v_allocatable = 1;
+                v->v_pointerdeclare = 0;
+            }
+            out = 1;
+        }
+        parcours = parcours -> suiv;
+    }
+    if (out == 1)
+    {
+        fprintf(fortran_out, "      end type Agrif_%s\n", curmodulename);
+        sprintf(ligne, "type(Agrif_%s), dimension(:), allocatable :: Agrif_%s_var",curmodulename, curmodulename);
+        tofich(fortran_out,ligne,1);
+        fprintf(fortran_out, "      public :: Agrif_%s\n", curmodulename);
+        fprintf(fortran_out, "      public :: Agrif_%s_var\n", curmodulename);
+    }
+
+    // Write NotGridDepend declaration
+    parcours = List_NotGridDepend_Var;
+    while( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
+        {
+            WriteVarDeclaration(parcours->var, fortran_out, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    // Write Alloc_agrif_'modulename' subroutine
+    parcours_nomprec = (listnom*) NULL;
+    parcours_nom = List_NameOfModule;
+    out = 0 ;
+    while ( parcours_nom && out == 0 )
+    {
+        if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
+        else parcours_nom = parcours_nom -> suiv;
+    }
+    if ( ! out )
+    {
+        printf("#\n# Write_Closing_Module : OUT == 0   *** /!\\ ***\n");
+        printf("# FIXME: POSSIBLE BUG in CONV !!!\n#\n");
+    }
+    if ( out )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out,"\n      public :: Alloc_agrif_%s\n",curmodulename);
+        }
+        if ( (forend == 0) || (parcours_nom->o_val == 1) )
+        {
+           fprintf(fortran_out,"\n      contains\n");
+        }
+        if ( parcours_nom->o_val == 1 )
+        {
+            fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", curmodulename);
+            fprintf(fortran_out, "          use Agrif_Util\n");
+            fprintf(fortran_out, "          type(Agrif_grid), pointer :: Agrif_Gr\n");
+            fprintf(fortran_out, "          integer :: i\n");
+            fprintf(fortran_out, "\n#include \"alloc_agrif_%s.h\"\n", curmodulename);
+            fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", curmodulename);
+            Add_Subroutine_For_Alloc(curmodulename);
+        }
+        else
+        {
+            parcours_nom = List_Subroutine_For_Alloc;
+            out = 0;
+            while ( parcours_nom && out == 0 )
+            {
+                if ( !strcasecmp(parcours_nom->o_nom, curmodulename) ) out = 1;
+                else
+                {
+                    parcours_nomprec = parcours_nom;
+                    parcours_nom = parcours_nom->suiv;
+                }
+            }
+            if ( out )
+            {
+                if ( parcours_nom == List_Subroutine_For_Alloc)
+                {
+                    List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
+                }
+                else
+                {
+                    parcours_nomprec->suiv = parcours_nom->suiv;
+                    parcours_nom = parcours_nomprec->suiv ;
+                }
+            }
+        }
+    }
+}
+
+/******************************************************************************/
+/*                          IsTabvarsUseInArgument_0                          */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int IsTabvarsUseInArgument_0()
+{
+   int out;
+   int doloopout;
+   listvar *parcours;
+
+   out=1;
+
+   if ( List_UsedInSubroutine_Var )
+   {
+      doloopout = 0;
+      parcours = List_UsedInSubroutine_Var;
+      while ( parcours && doloopout == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+                                                                  doloopout = 1;
+         else parcours = parcours->suiv;
+      }
+      if (  doloopout == 0 ) out = 0;
+      else out = 1 ;
+   }
+   else out = 0;
+
+   return out;
+}
+
+
+/******************************************************************************/
+/*                        ImplicitNoneInSubroutine                            */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int ImplicitNoneInSubroutine()
+{
+  listname *parcours;
+  int out;
+
+  parcours= List_ImplicitNoneSubroutine;
+  out = 0 ;
+  while ( parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->n_name,subroutinename) ) out = 1;
+     else parcours = parcours->suiv;
+  }
+  return out;
+}
+
+/******************************************************************************/
+/*                            Add_Pointer_Var_From_List_1                     */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Pointer_Var_From_List_1(listvar *listin)
+{
+   listvar *parcours;
+
+   if ( firstpass == 1 )
+   {
+       parcours = listin;
+       while ( parcours )
+       {
+          Add_Pointer_Var_1(parcours->var->v_nomvar);
+          parcours = parcours -> suiv ;
+       }
+   }
+}
+
+/******************************************************************************/
+/*                            Add_Pointer_Var_1                               */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Pointer_Var_1(char *nom)
+{
+   listname *newvar;
+   listname *parcours;
+   int out;
+
+   if ( firstpass == 1 )
+   {
+      if ( !List_Pointer_Var )
+      {
+         newvar = (listname*) calloc(1, sizeof(listname));
+         strcpy(newvar->n_name, nom);
+         newvar->suiv = NULL;
+         List_Pointer_Var = newvar;
+      }
+      else
+      {
+         parcours = List_Pointer_Var;
+         out = 0 ;
+         while ( parcours->suiv && out == 0 )
+         {
+            if (  !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else
+               parcours=parcours->suiv;
+         }
+         if ( out == 0 )
+         {
+            if (  !strcasecmp(parcours->n_name,nom) ) out = 1;
+            else
+            {
+               /* add the record                                              */
+              newvar = (listname*) calloc(1, sizeof(listname));
+              strcpy(newvar->n_name,nom);
+              newvar->suiv = NULL;
+              parcours->suiv = newvar;
+            }
+         }
+      }
+   }
+}
+
+/******************************************************************************/
+/*                          varispointer_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int varispointer_0(char *ident)
+{
+   listname *newname;
+   int out;
+
+   out =0;
+   if ( firstpass == 0 )
+   {
+      newname = List_Pointer_Var;
+      while( newname && out == 0 )
+      {
+         if ( !strcasecmp(ident,newname->n_name) ) out = 1 ;
+         else newname = newname->suiv;
+      }
+   }
+   return out;
+}
+
+/******************************************************************************/
+/*                          varistyped_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int varistyped_0(char *ident)
+{
+   listvar *parcours;
+   int out;
+
+   out =0;
+   if ( firstpass == 0 )
+   {
+      parcours = List_Global_Var;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(ident,parcours->var->v_nomvar) )
+             {
+             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1;
+             }
+         parcours = parcours->suiv;
+      }
+   }
+   return out;
+}
+
+
+/******************************************************************************/
+/*                          VariableIsFunction                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int VariableIsFunction(const char *ident)
+{
+    int out;
+    listvar *newvar;
+
+    out = 0;
+
+    if ( !strcasecmp(ident,"size") ||
+         !strcasecmp(ident,"if")   ||
+         !strcasecmp(ident,"max")  ||
+         !strcasecmp(ident,"min")  )
+    {
+        newvar = List_SubroutineDeclaration_Var;
+        while ( newvar && out == 0 )
+        {
+            if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
+                 !strcasecmp(ident, newvar->var->v_nomvar) )
+            {
+                out = 1;
+            }
+            newvar = newvar -> suiv ;
+        }
+        if ( out == 0 ) /* if it has not been found */
+        {
+            newvar = List_Global_Var;
+            while ( newvar && out == 0 )
+            {
+                if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
+                newvar = newvar -> suiv ;
+            }
+        }
+    }
+    return (out == 0);
+}
+
+void dump_var(const variable* var)
+{
+    fprintf(stderr, "   var->v_nomvar : %s\n",var->v_nomvar);
+    fprintf(stderr, "   var->v_indice : %d\n",var->v_indicetabvars);
+    fprintf(stderr, "   var->v_typevar: %s\n",var->v_typevar);
+    fprintf(stderr, "   var->v_catvar : %d\n",var->v_catvar);
+    fprintf(stderr, "   var->v_modulename: %s\n",var->v_modulename);
+    fprintf(stderr, "   var->v_subroutinename: %s\n",var->v_subroutinename);
+    fprintf(stderr, "   var->v_commonname: %s\n",var->v_commonname);
+    fprintf(stderr, "   var->v_commoninfile: %s\n",var->v_commoninfile);
+    fprintf(stderr, "   var->v_nbdim: %d\n",var->v_nbdim);
+    fprintf(stderr, "   var->v_common: %d\n",var->v_common);
+    fprintf(stderr, "   var->v_module: %d\n",var->v_module);
+    fprintf(stderr, "   var->v_initialvalue: %s\n",var->v_initialvalue);
+}
Index: vendors/AGRIF/LIB/UtilListe.c
===================================================================
--- vendors/AGRIF/LIB/UtilListe.c	(revision 9621)
+++ vendors/AGRIF/LIB/UtilListe.c	(revision 9621)
@@ -0,0 +1,706 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+void Init_Variable(variable *var)
+{
+   strcpy(var->v_typevar            , "");
+   strcpy(var->v_nomvar             , "");
+   strcpy(var->v_oldname            , "");
+   strcpy(var->v_dimchar            , "");
+   strcpy(var->v_modulename         , "");
+   strcpy(var->v_commonname         , "");
+   strcpy(var->v_vallengspec        , "");
+   strcpy(var->v_nameinttypename    , "");
+   strcpy(var->v_commoninfile       , "");
+   strcpy(var->v_subroutinename     , "");
+   strcpy(var->v_precision          , "");
+   strcpy(var->v_initialvalue       , "");
+   strcpy(var->v_IntentSpec         , "");
+   strcpy(var->v_readedlistdimension, "");
+   var->v_nbdim               = 0 ;
+   var->v_common              = 0 ;
+   var->v_positioninblock     = 0 ;
+   var->v_module              = 0 ;
+   var->v_save                = 0 ;
+   var->v_catvar              = 0 ;
+   var->v_VariableIsParameter = 0 ;
+   var->v_PublicDeclare       = 0 ;
+   var->v_PrivateDeclare      = 0 ;
+   var->v_ExternalDeclare     = 0 ;
+   var->v_pointedvar          = 0 ;
+   var->v_notgrid             = 0 ;
+   var->v_dimensiongiven      = 0 ;
+   var->v_c_star              = 0 ;
+   var->v_indicetabvars       = 0 ;
+   var->v_pointerdeclare      = 0 ;
+   var->v_optionaldeclare     = 0 ;
+   var->v_allocatable         = 0 ;
+   var->v_target              = 0 ;
+   var->v_dimsempty           = 0 ;
+   var->v_dimension = (listdim *) NULL;
+}
+/******************************************************************************/
+/*                            AddListvartolistvar                             */
+/******************************************************************************/
+/* This subroutine is used to add a listvar l at the end of a listvar         */
+/* glob.                                                                      */
+/*                                                                            */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + glob +--->+ glob +--->+ glob +--->+ glob +--->+  l   +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass )
+{
+    listvar *newvar;
+    if ( firstpass == ValueFirstpass )
+    {
+        if ( !glob ) glob = l;
+        else
+        {
+            newvar = glob;
+            while (newvar->suiv)
+                newvar = newvar->suiv;
+            newvar->suiv = l;
+        }
+    }
+    return glob;
+}
+
+/******************************************************************************/
+/*                       CreateAndFillin_Curvar                               */
+/******************************************************************************/
+/* This subroutine is used to create the record corresponding to the          */
+/* list of declaration                                                        */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void CreateAndFillin_Curvar(const char *type, variable *curvar)
+{
+    if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") )
+    {
+        strcpy(curvar->v_dimchar, CharacterSize);
+    }
+
+    /* On donne la precision de la variable si elle a ete donnee                */
+    curvar->v_c_star = 0;
+    if ( c_star == 1 )  curvar->v_c_star = 1;
+
+    strcpy(curvar->v_vallengspec,"");
+    if ( strcasecmp(vallengspec,"") )
+    {
+        strcpy(curvar->v_vallengspec,vallengspec);
+        Save_Length(vallengspec,8);
+    }
+
+    strcpy(curvar->v_precision,"");
+    if ( strcasecmp(NamePrecision,"") )
+    {
+        strcpy(curvar->v_precision,NamePrecision);
+        addprecision_derivedfromkind(curvar);
+        Save_Length(NamePrecision,12);
+    }
+    /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
+    if ( inmoduledeclare == 1 || SaveDeclare == 1 )
+    {
+        curvar->v_module = 1;
+    }
+    /* Puis on donne le nom du module dans curvar->v_modulename                */
+    strcpy(curvar->v_modulename,curmodulename);
+    /* Si cette variable a ete initialisee                                     */
+    if (InitialValueGiven == 1 )
+    {
+        strcpy(curvar->v_initialvalue,InitValue);
+        Save_Length(InitValue,14);
+    }
+    /* Si cette variable est declaree en save                                  */
+    if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1;
+
+    /* Si cette variable est v_allocatable                                     */
+    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
+
+    /* Si cette variable est v_target                                     */
+    if (Targetdeclare == 1 ) curvar->v_target=1;
+
+    /* if INTENT spec has been given                                           */
+    if ( strcasecmp(IntentSpec,"") )
+    {
+        strcpy(curvar->v_IntentSpec,IntentSpec);
+        Save_Length(IntentSpec,13);
+    }
+}
+
+
+void addprecision_derivedfromkind(variable *curvar)
+{
+    listnom *parcours;
+    char kind[LONG_VNAME];
+    char kind_val[LONG_C];
+
+    sscanf(curvar->v_precision, "%100s =", kind_val);
+
+    if ( !strcasecmp(kind_val, "kind") )
+        sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val);
+
+    parcours = listofkind;
+    while (parcours)
+    {
+        if ( !strcasecmp(parcours->o_nom, kind_val) )
+        {
+            sprintf(curvar->v_nameinttypename, "%d", parcours->o_val);
+        }
+        parcours=parcours->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                        duplicatelistvar                                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+// void duplicatelistvar(listvar *orig)
+// {
+//    listvar *parcours;
+//    listvar *tmplistvar;
+//    listvar *tmplistvarprec;
+//    listdim *tmplistdim;
+//    variable *tmpvar;
+//
+//    tmplistvarprec = (listvar *)NULL;
+//    parcours = orig;
+//    while ( parcours )
+//    {
+//       tmplistvar = (listvar *)calloc(1,sizeof(listvar));
+//       tmpvar = (variable *)calloc(1,sizeof(variable));
+//       /*                                                                      */
+//       Init_Variable(tmpvar);
+//       /*                                                                      */
+//       strcpy(tmpvar->v_typevar, parcours->var->v_typevar);
+//       strcpy(tmpvar->v_nomvar,  parcours->var->v_nomvar);
+//       strcpy(tmpvar->v_oldname, parcours->var->v_oldname);
+//       strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar);
+//       if ( parcours->var->v_dimension )
+//       {
+//          tmplistdim = (listdim*) calloc(1,sizeof(listdim));
+//          tmplistdim = parcours->var->v_dimension;
+//          tmpvar->v_dimension = tmplistdim;
+//       }
+//       tmpvar->v_nbdim  = parcours->var->v_nbdim;
+//       tmpvar->v_common = parcours->var->v_common;
+//       tmpvar->v_module = parcours->var->v_module;
+//       tmpvar->v_save   = parcours->var->v_save;
+//       tmpvar->v_positioninblock = parcours->var->v_positioninblock;
+//       tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter;
+//       tmpvar->v_indicetabvars = parcours->var->v_indicetabvars;
+//       tmpvar->v_pointedvar    = parcours->var->v_pointedvar;
+//       tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven;
+//       tmpvar->v_c_star = parcours->var->v_c_star;
+//       tmpvar->v_catvar = parcours->var->v_catvar;
+//       tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare;
+//       tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare;
+//       tmpvar->v_allocatable = parcours->var->v_allocatable;
+//       tmpvar->v_target      = parcours->var->v_target;
+//       tmpvar->v_dimsempty   = parcours->var->v_dimsempty;
+//       strcpy(tmpvar->v_modulename,  parcours->var->v_modulename);
+//       strcpy(tmpvar->v_commonname,  parcours->var->v_commonname);
+//       strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec);
+//       strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename);
+//       strcpy(tmpvar->v_commoninfile, cur_filename);
+//       strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename);
+//       strcpy(tmpvar->v_precision, parcours->var->v_precision);
+//       strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue);
+//       strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec);
+//       strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension);
+//
+//       tmplistvar->var = tmpvar;
+//       tmplistvar->suiv = NULL;
+//
+//       if ( !listduplicated )
+//       {
+//          listduplicated = tmplistvar;
+//          tmplistvarprec = listduplicated;
+//       }
+//       else
+//       {
+//          tmplistvarprec->suiv = tmplistvar;
+//          tmplistvarprec = tmplistvar;
+//       }
+//       parcours = parcours->suiv;
+//    }
+// }
+
+/******************************************************************************/
+/*                           insertdim                                        */
+/******************************************************************************/
+/* This subroutine is used to insert a record in a list of                    */
+/* struct : listdim                                                           */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ lin  +--->+ lin  +--->+ lin  +--->+  lin +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+listdim * insertdim(listdim *lin,typedim nom)
+{
+   listdim *newdim ;
+   listdim *parcours ;
+
+   newdim=(listdim *) calloc(1,sizeof(listdim));
+   newdim->dim=nom;
+   newdim->suiv=NULL;
+
+   if ( ! lin )
+   {
+      lin = newdim;
+   }
+   else
+   {
+      parcours = lin;
+      while ( parcours->suiv ) parcours=parcours->suiv;
+      parcours->suiv = newdim;
+   }
+
+   return lin;
+}
+
+/******************************************************************************/
+/*                            change_dim_char                                 */
+/******************************************************************************/
+/* This subroutine is used to change the dimension in the list lin            */
+/******************************************************************************/
+/*        _______     _______                 _______     _______             */
+/*       +  l   +    +  l   +                +  l   +    +   l  +             */
+/*       + old  +--->+ old  +--------------->+ lin  +--->+  lin +             */
+/*       +______+    +______+                +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void change_dim_char(listdim *lin,listvar * l)
+{
+   listvar *parcours_var;
+   variable *v;
+
+   parcours_var=l;
+   while(parcours_var)
+   {
+      v = parcours_var->var;
+      strcpy(v->v_dimchar,(lin->dim).last);
+      parcours_var=parcours_var->suiv;
+   }
+}
+
+
+/******************************************************************************/
+/*                              get_num_dims                                  */
+/******************************************************************************/
+/* This subroutine is used to know the dimension of a table                   */
+/******************************************************************************/
+/*                                                                            */
+/*             Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3            */
+/*                                                                            */
+/******************************************************************************/
+int get_num_dims ( const listdim *d )
+{
+    listdim *parcours;
+    int compteur = 0;
+
+    parcours = (listdim *) d;
+    while(parcours)
+    {
+        compteur++;
+        parcours = parcours->suiv;
+    }
+    return compteur;
+}
+
+
+/******************************************************************************/
+/*                          CREATEVAR                                         */
+/******************************************************************************/
+/* This subroutine is used to create and initialized a record of the          */
+/*      struct : variable                                                     */
+/******************************************************************************/
+variable * createvar(const char *nom, listdim *d)
+{
+    variable *var;
+    listdim *dims;
+    char ligne[LONG_M];
+    char listdimension[LONG_M];
+
+    var = (variable *) calloc(1,sizeof(variable));
+
+    Init_Variable(var);
+
+    strcpy(listdimension,"");
+    strcpy(var->v_nomvar,nom);
+    strcpy(var->v_modulename,curmodulename);
+    strcpy(var->v_commoninfile,cur_filename);
+    strcpy(var->v_subroutinename,subroutinename);
+
+    if ( strcasecmp(nameinttypename,"") )
+    {
+        strcpy(var->v_nameinttypename,nameinttypename);
+    }
+
+    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
+    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
+    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
+    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
+    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
+    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
+
+   var->v_dimension = d;
+
+   /* Creation of the string for the dimension of this variable               */
+    dimsempty = 1;
+    if ( d )
+    {
+        var->v_dimensiongiven = 1;
+        dims = d;
+        while (dims)
+        {
+            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
+            {
+                dimsempty = 0;
+            }
+            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+            strcat(listdimension,ligne);
+            if ( dims->suiv )
+            {
+                strcat(listdimension,",");
+            }
+            dims = dims->suiv;
+        }
+        if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1;
+    }
+    strcpy(var->v_readedlistdimension,listdimension);
+    Save_Length(listdimension,15);
+    var->v_nbdim = get_num_dims(d);
+
+    return var;
+}
+
+/******************************************************************************/
+/*                            INSERTVAR                                       */
+/******************************************************************************/
+/* This subroutine is used to insert a record in a list of the                */
+/*      struct : listvar                                                      */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ NEW  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listvar * insertvar(listvar *lin,variable *v)
+{
+   listvar *newvar ;
+   listvar *tmpvar ;
+
+   newvar=(listvar *) calloc(1,sizeof(listvar));
+   newvar->var=v;
+   newvar->suiv = NULL;
+   if (!lin)
+   {
+      newvar->suiv=NULL;
+      lin = newvar;
+   }
+   else
+   {
+      tmpvar = lin ;
+      while (tmpvar->suiv)
+      {
+         tmpvar = tmpvar ->suiv ;
+      }
+      tmpvar -> suiv = newvar;
+   }
+   return lin;
+}
+
+/******************************************************************************/
+/*                             SETTYPE                                        */
+/******************************************************************************/
+/* This subroutine is used to give the same variable type at each             */
+/*      record of the list of the struct : listvar                            */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       + REAL +    + REAL +    + REAL +    + REAL +    + REAL +             */
+/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ lin  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listvar *settype(const char *nom, listvar *lin)
+{
+   listvar *newvar;
+   variable *v;
+
+   newvar = lin;
+   while (newvar)
+   {
+      v = newvar->var;
+      strcpy(v->v_typevar,nom);
+      v->v_catvar = get_cat_var(v);
+      newvar = newvar->suiv;
+   }
+   newvar = lin;
+   return newvar ;
+}
+
+/******************************************************************/
+/* printliste  */
+/* print the list given in argulent */
+/******************************************************************/
+
+void printliste(listvar * lin)
+{
+   listvar *newvar;
+   variable *v;
+
+   newvar=lin;
+   while (newvar)
+   {
+      v=newvar->var;
+      printf("nom = %s, allocatable = %d dim = %s\n",v->v_nomvar,v->v_allocatable,(v->v_dimension)->dim.last);
+      newvar=newvar->suiv;
+   }
+}
+
+/******************************************************************************/
+/*   IsinListe : return 1 if name nom is in list lin                          */
+/*                                                                            */
+/******************************************************************************/
+ int IsinListe(listvar *lin,char *nom)
+{
+   listvar *newvar;
+   variable *v;
+   int out ;
+
+   newvar=lin;
+   out = 0;
+   while (newvar && (out == 0))
+   {
+      v=newvar->var;
+      if (!strcasecmp(v->v_nomvar,nom) && !strcasecmp(v->v_subroutinename,subroutinename)) {
+      out = 1;
+      }
+      newvar=newvar->suiv;
+   }
+
+   return out ;
+}
+
+listname *Insertname(listname *lin,char *nom, int sens)
+{
+   listname *newvar ;
+   listname *tmpvar;
+
+   newvar=(listname *) calloc(1,sizeof(listname));
+   strcpy(newvar->n_name,nom);
+   newvar->suiv = NULL;
+   if (!lin)
+   {
+      newvar->suiv=NULL;
+      lin = newvar;
+   }
+   else
+   {
+      if (sens == 0)
+      {
+      tmpvar = lin ;
+      while (tmpvar->suiv)
+      {
+         tmpvar = tmpvar ->suiv ;
+      }
+      tmpvar -> suiv = newvar;
+      }
+      else
+      {
+      newvar->suiv = lin;
+      lin = newvar;
+      }
+   }
+   return lin;
+}
+
+listname *concat_listname(listname *l1, listname *l2)
+{
+   listname *tmpvar;
+
+   tmpvar = l1;
+   while (tmpvar->suiv)
+   {
+    tmpvar = tmpvar->suiv;
+   }
+
+   tmpvar->suiv = l2;
+
+   return l1;
+}
+
+void createstringfromlistname(char *ligne, listname *lin)
+{
+    listname *tmpvar;
+
+    strcpy(ligne,"");
+    tmpvar = lin;
+
+    while(tmpvar)
+    {
+        strcat(ligne,tmpvar->n_name);
+        if (tmpvar->suiv) strcat(ligne,",");
+        tmpvar=tmpvar->suiv;
+    }
+}
+
+/******************************************************************/
+/* printname  */
+/* print the list given in argulent */
+/******************************************************************/
+
+void printname(listname * lin)
+{
+   listname *newvar;
+
+   newvar=lin;
+   while (newvar)
+   {
+      printf("nom = %s \n",newvar->n_name);
+      newvar=newvar->suiv;
+   }
+}
+
+void removeglobfromlist(listname **lin)
+{
+  listname *parcours1;
+  listvar *parcours2;
+  listname * parcourspres;
+  int out;
+
+  parcours1 = *lin;
+  parcourspres = (listname *)NULL;
+
+  while (parcours1)
+  {
+  parcours2 = List_Global_Var;
+  out = 0;
+  while (parcours2 && out == 0)
+  {
+    if (!strcasecmp(parcours2->var->v_nomvar,parcours1->n_name))
+    {
+    out = 1;
+    }
+    parcours2 = parcours2->suiv;
+  }
+  if (out == 1)
+  {
+  if (parcours1 == *lin)
+   {
+   *lin = (*lin)->suiv;
+   parcours1 = *lin;
+   }
+   else
+   {
+   parcourspres->suiv = parcours1->suiv;
+   parcours1 = parcourspres->suiv;
+   }
+   }
+   else
+   {
+   parcourspres = parcours1;
+    parcours1 = parcours1->suiv;
+    }
+  }
+}
+
+void writelistpublic(listname *lin)
+{
+    listname *parcours1;
+    char ligne[LONG_M];
+
+    if (lin)
+    {
+        sprintf(ligne,"public :: ");
+        parcours1 = lin;
+
+        while ( parcours1 )
+        {
+            strcat(ligne, parcours1->n_name);
+            if ( parcours1->suiv ) strcat(ligne,", ");
+            parcours1 = parcours1->suiv;
+        }
+        tofich(fortran_out,ligne,1);
+    }
+}
+
+void Init_List_Data_Var()
+{
+    listvar *parcours;
+
+    parcours = List_Data_Var_Cur;
+
+    if (List_Data_Var_Cur)
+    {
+        while (parcours)
+        {
+            List_Data_Var_Cur = List_Data_Var_Cur->suiv;
+            free(parcours);
+            parcours = List_Data_Var_Cur;
+        }
+    }
+    List_Data_Var_Cur = NULL;
+}
+
+int get_cat_var(variable *var)
+{
+    if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        return 1;
+    else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL")))
+        return 2;
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        return 3;
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        return 4;
+    else
+        return 0;
+}
Index: vendors/AGRIF/LIB/UtilNotGridDep.c
===================================================================
--- vendors/AGRIF/LIB/UtilNotGridDep.c	(revision 9621)
+++ vendors/AGRIF/LIB/UtilNotGridDep.c	(revision 9621)
@@ -0,0 +1,107 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                     Add_NotGridDepend_Var_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a record into List_NotGridDepend_Var        */
+/*    This variable is add only if it is not present in the list              */
+/*    This variable is add at the end of the list                             */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       + not  +    + not  +    +  not +    +  not +    +      +             */
+/*       + grid +--->+ grid +--->+ grid +--->+ grid +--->+ NEW  +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void Add_NotGridDepend_Var_1 (char *name)
+{
+   listvar *parcours;
+   listvar *newvar;
+   /*                                                                         */
+   /* look in the List_NotGridDepend_Var if this variable exist               */
+   parcours = List_NotGridDepend_Var;
+   while (parcours)
+   {
+     if (!strcasecmp(parcours->var->v_nomvar,name))
+     {
+        /* if this variable exist -> exit of the program                      */
+        printf(" The variable %s\n",name);
+        printf(" has been declared twice \n");
+        printf(" as a non grid dependent variable \n");
+        exit(1);
+     }
+     parcours= parcours->suiv;
+   }
+   /* if variable does not exist, we add it                                   */
+   newvar=(listvar *)calloc(1,sizeof(listvar));
+   newvar->var=(variable *)calloc(1,sizeof(variable));
+   strcpy(newvar->var->v_nomvar,name);
+   strcpy(newvar->var->v_commoninfile,cur_filename);
+   strcpy(newvar->var->v_subroutinename,subroutinename);
+   newvar->var->v_notgrid = 1 ;
+   newvar->suiv = List_NotGridDepend_Var;
+   List_NotGridDepend_Var = newvar;
+}
+
+/******************************************************************************/
+/*                      VarIsNonGridDepend                                    */
+/******************************************************************************/
+/* This subroutine is used to know if a variable has been declared as non     */
+/* grid dependent                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  notgriddepend variable;    ----------->  VarIsNonGridDepend = 1           */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+int VarIsNonGridDepend(char *name)
+{
+   listvar *newvar;
+   int out;
+
+   newvar = List_NotGridDepend_Var;
+   out=0;
+   while (newvar && out == 0 )
+   {
+      if ( !strcasecmp(newvar->var->v_nomvar,name) ) out = 1;
+      else newvar = newvar->suiv;
+   }
+   return out;
+}
Index: vendors/AGRIF/LIB/WorkWithAllocatelist.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithAllocatelist.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithAllocatelist.c	(revision 9621)
@@ -0,0 +1,122 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                               Add_Allocate_Var_1                           */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Allocate_Var_1(const char *nom, const char *nommodule)
+{
+   listallocate *newvar;
+   listallocate *parcours;
+   int out;
+
+   if ( firstpass == 1 )
+   {
+      if ( !List_Allocate_Var )
+      {
+         newvar = (listallocate *)calloc(1,sizeof(listallocate));
+         strcpy(newvar->a_nomvar,nom);
+         strcpy(newvar->a_subroutine,subroutinename);
+         strcpy(newvar->a_module,nommodule);
+         Save_Length(nom,25);
+         newvar->suiv = NULL;
+         List_Allocate_Var = newvar;
+      }
+      else
+      {
+         parcours = List_Allocate_Var;
+         out = 0 ;
+         while ( parcours->suiv && out == 0 )
+         {
+            if (  !strcasecmp(parcours->a_nomvar, nom) &&
+                  !strcasecmp(parcours->a_subroutine, subroutinename) &&
+                  !strcasecmp(parcours->a_module, nommodule) ) out = 1;
+            else
+               parcours=parcours->suiv;
+         }
+         if ( out == 0 )
+         {
+            if (  !strcasecmp(parcours->a_nomvar,nom) &&
+                  !strcasecmp(parcours->a_subroutine,subroutinename) &&
+                  !strcasecmp(parcours->a_module,nommodule) ) out = 1;
+            else
+            {
+               /* add the record                                              */
+              newvar = (listallocate *)calloc(1,sizeof(listallocate));
+              strcpy(newvar->a_nomvar, nom);
+              strcpy(newvar->a_subroutine, subroutinename);
+              strcpy(newvar->a_module, nommodule);
+              Save_Length(nom,25);
+              newvar->suiv = NULL;
+              parcours->suiv = newvar;
+            }
+         }
+      }
+   }
+}
+
+
+/******************************************************************************/
+/*                            IsVarAllocatable_0                              */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+// int IsVarAllocatable_0(const char *ident)
+// {
+//    listallocate *parcours;
+//    int out;
+// 
+//    out = 0 ;
+//    if ( firstpass == 0 )
+//    {
+//       parcours = List_Allocate_Var;
+//       while ( parcours && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours->a_nomvar,ident)  ) out = 1 ;
+//          else parcours=parcours->suiv;
+//       }
+//    }
+//    return out;
+// }
Index: vendors/AGRIF/LIB/WorkWithParameterlist.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithParameterlist.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithParameterlist.c	(revision 9621)
@@ -0,0 +1,101 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                       Add_GlobalParameter_Var_1                            */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_GlobalParameter_Var_1(listvar *listin)
+{
+    if ( VariableIsParameter )
+        List_GlobalParameter_Var =  AddListvarToListvar(listin, List_GlobalParameter_Var, 1);
+}
+
+/******************************************************************************/
+/*                       Add_Parameter_Var_1                                  */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Parameter_Var_1(listvar *listin)
+{
+    listvar *parcours;
+
+    if ( !VariableIsParameter )    return;
+
+    if ( List_Parameter_Var == NULL )
+    {
+        List_Parameter_Var = listin;
+    }
+    else
+    {
+        parcours = List_Parameter_Var;
+        while ( parcours->suiv )
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
+}
+
+/******************************************************************************/
+/*                       Add_Dimension_Var_1                                  */
+/******************************************************************************/
+/*  This subroutines is used to add the variable defined in common in the     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_Dimension_Var_1(listvar *listin)
+{
+   listvar *parcours;
+
+    if ( List_Dimension_Var == NULL )
+    {
+        List_Dimension_Var = listin;
+    }
+    else
+    {
+        parcours = List_Dimension_Var;
+        while (parcours->suiv)
+            parcours = parcours->suiv;
+        parcours->suiv = listin;
+    }
+}
Index: vendors/AGRIF/LIB/WorkWithglobliste.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithglobliste.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithglobliste.c	(revision 9621)
@@ -0,0 +1,107 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                          Add_Globliste_1                                   */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should add this declaration to the List_Global_Var                      */
+/******************************************************************************/
+void Add_Globliste_1(listvar *listtoadd)
+{
+    if ( aftercontainsdeclare == 0 && VariableIsParameter == 0 )
+    {
+        List_Global_Var = AddListvarToListvar(listtoadd, List_Global_Var, 1);
+    }
+}
+
+/******************************************************************************/
+/*                  Add_SubroutineDeclarationSave_Var_1                       */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should add this declaration to the List_Global_Var. case SAVE           */
+/******************************************************************************/
+void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd)
+{
+   if ( firstpass == 1 )
+   {
+      if ( VariableIsParameter == 0 &&
+           SaveDeclare         == 1 )
+      {
+         List_Global_Var = AddListvarToListvar(listtoadd,List_Global_Var,1);
+      }
+   }
+}
+
+void checkandchangedims(listvar *listsecondpass)
+{
+listvar *parcours;
+listvar *parcours1;
+variable * newvar;
+variable * oldvar;
+
+int out ;
+
+printliste(List_Global_Var);
+printliste(List_SubroutineDeclaration_Var);
+
+parcours = listsecondpass;
+while (parcours)
+{
+newvar = parcours->var;
+parcours1 = List_SubroutineDeclaration_Var;
+out = 0;
+while (parcours1 && out == 0)
+{
+  oldvar = parcours1->var;
+  if (!strcasecmp(newvar->v_nomvar,oldvar->v_nomvar) && !strcasecmp(newvar->v_subroutinename,subroutinename))
+   {
+   if (newvar->v_dimensiongiven == 1)
+   {
+    strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last);
+    strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first);
+   }
+   out = 1;
+   }
+  parcours1 = parcours1->suiv;
+}
+parcours = parcours->suiv;
+}
+printliste(List_SubroutineDeclaration_Var);
+}
Index: vendors/AGRIF/LIB/WorkWithlistdatavariable.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithlistdatavariable.c	(revision 9621)
@@ -0,0 +1,145 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+/******************************************************************************/
+/*                          Add_Data_Var_1                                    */
+/******************************************************************************/
+/* This subroutine is used to add a record to List_Data_Var                   */
+/******************************************************************************/
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ data +--->+ data +--->+ data +--->+  data+             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/******************************************************************************/
+void Add_Data_Var_1 (listvar **curlist,char *name,char *values)
+{
+  listvar *newvar;
+  char ligne[LONG_M];
+
+//  if ( firstpass == 1 )
+//  {
+     newvar=(listvar *)calloc(1,sizeof(listvar));
+     newvar->var=(variable *)calloc(1,sizeof(variable));
+     /*                                                                       */
+     Init_Variable(newvar->var);
+     /*                                                                       */
+     if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
+     strcpy(newvar->var->v_nomvar,name);
+     strcpy(newvar->var->v_subroutinename,subroutinename);
+     strcpy(newvar->var->v_modulename,curmodulename);
+     strcpy(newvar->var->v_commoninfile,cur_filename);
+     if (strchr(values,',') && strncasecmp(values,"'",1))
+        sprintf(ligne,"(/%s/)",values);
+     else
+        strcpy(ligne,values);
+       
+     strcpy(newvar->var->v_initialvalue,ligne);
+     Save_Length(ligne,14);
+     newvar->suiv = NULL;
+     if ( ! (*curlist) )
+     {
+        *curlist  = newvar ;
+     }
+     else
+     {
+        newvar->suiv = *curlist;
+        *curlist = newvar;
+     }
+//  }
+}
+
+void Add_Data_Var_Names_01 (listvar **curlist,listname *l1,listname *l2)
+{
+    listvar *newvar;
+    listvar *tmpvar;
+    listname *tmpvar1;
+    listname *tmpvar2;  
+    variable *found_var = NULL;
+    
+    tmpvar1 = l1;
+    tmpvar2 = l2;
+  
+    while (tmpvar1)
+    {
+        newvar = (listvar *) calloc(1,sizeof(listvar));
+        newvar->var = (variable *) calloc(1,sizeof(variable));
+
+        Init_Variable(newvar->var);
+
+        if ( inmoduledeclare == 1 ) newvar->var->v_module=1;
+     
+        found_var = get_variable_in_list_from_name(List_Common_Var, tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_Global_Var,tmpvar1->n_name);
+        if ( ! found_var )  found_var = get_variable_in_list_from_name(List_SubroutineDeclaration_Var,tmpvar1->n_name);
+        
+        if ( found_var && found_var->v_nbdim > 0 )
+        {
+            printf("##############################################################################################################\n");
+            printf("## CONV Error : arrays in data_stmt_object lists not yet supported. Please complain to the proper authorities.\n");
+            printf("##   variable name : %s (in %s:%s:%s)\n", found_var->v_nomvar, found_var->v_modulename,
+                                                              found_var->v_subroutinename, found_var->v_commonname);
+            exit(1);
+        }
+        
+        strcpy(newvar->var->v_nomvar,tmpvar1->n_name);
+        strcpy(newvar->var->v_subroutinename,subroutinename);
+        strcpy(newvar->var->v_modulename,curmodulename);
+        strcpy(newvar->var->v_commoninfile,cur_filename);
+        strcpy(newvar->var->v_initialvalue,tmpvar2->n_name);
+
+        Save_Length(tmpvar2->n_name,14);
+
+        newvar->suiv = NULL;
+     
+        if ( *curlist != NULL )
+        {
+            tmpvar = *curlist;
+            while (tmpvar->suiv)
+                tmpvar = tmpvar->suiv;
+            tmpvar->suiv = newvar;
+        }
+        else
+        {
+            *curlist  = newvar ;
+        }
+     
+        tmpvar1 = tmpvar1->suiv;
+        tmpvar2 = tmpvar2->suiv;  
+    }
+}
Index: vendors/AGRIF/LIB/WorkWithlistmoduleinfile.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithlistmoduleinfile.c	(revision 9621)
@@ -0,0 +1,160 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+void Save_Length(const char *nom, int whichone)
+{
+    size_t len_nom = strlen(nom);
+    
+   if ( whichone == 1  && len_nom > length_last )
+   {
+      length_last = len_nom;
+      if ( length_last > LONG_M )
+            printf("WARNING 1 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_last+100);
+   }
+   if ( whichone == 2  && len_nom > length_first )
+   {
+      length_first = len_nom;
+      if ( length_first > LONG_M )
+           printf("WARNING 2 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_first+100);
+   }
+   if ( whichone == 8  && len_nom > length_v_vallengspec )
+   {
+      length_v_vallengspec = len_nom;
+      if ( length_v_vallengspec > LONG_M )
+           printf("WARNING 8 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_vallengspec+100);
+   }
+   if ( whichone == 12 && len_nom > length_v_precision )
+   {
+      length_v_precision = len_nom;
+      if ( length_v_precision > LONG_M )
+           printf("WARNING 12 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_precision+100);
+   }
+   if ( whichone == 13 && len_nom > length_v_IntentSpec )
+   {
+      length_v_IntentSpec = len_nom;
+      if ( length_v_IntentSpec > LONG_M )
+           printf("WARNING 13 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_IntentSpec+100);
+   }
+   if ( whichone == 14 && len_nom > length_v_initialvalue )
+   {
+      length_v_initialvalue = len_nom;
+      if ( length_v_initialvalue > LONG_M )
+           printf("WARNING 14 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_initialvalue+100);
+   }
+   if ( whichone == 15 && len_nom > length_v_readedlistdimension )
+   {
+      length_v_readedlistdimension = len_nom;
+      if ( length_v_readedlistdimension > LONG_M )
+           printf("WARNING 15 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_readedlistdimension+100);
+   }
+   if ( whichone == 25 && len_nom > length_a_nomvar )
+   {
+      length_a_nomvar = len_nom;
+      if ( length_a_nomvar > LONG_C )
+           printf("WARNING 25 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_a_nomvar+100);
+   }
+   if ( whichone == 39 && len_nom > length_toprintglob )
+   {
+      length_toprintglob = len_nom;
+      if ( length_toprintglob > LONG_M )
+           printf("WARNING 39 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprintglob+100);
+   }
+   if ( whichone == 40 && len_nom > length_tmpvargridname )
+   {
+      length_tmpvargridname = len_nom;
+      if ( length_tmpvargridname > LONG_M )
+           printf("WARNING 40 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpvargridname+100);
+   }
+   if ( whichone == 41 && len_nom > length_ligne_Subloop )
+   {
+       length_ligne_Subloop = len_nom;
+      if ( length_ligne_Subloop > LONG_M )
+           printf("WARNING 41 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n",length_ligne_Subloop+100);
+   }
+   if ( whichone == 43 && len_nom > length_toprint_utilagrif )
+   {
+      length_toprint_utilagrif = len_nom;
+      if ( length_toprint_utilagrif > LONG_M )
+           printf("WARNING 43 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprint_utilagrif+100);
+   }
+   if ( whichone == 44 && len_nom > length_toprinttmp_utilchar )
+   {
+      length_toprinttmp_utilchar = len_nom;
+      if ( length_toprinttmp_utilchar > LONG_M)
+           printf("WARNING 44 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprinttmp_utilchar+100);
+   }
+   if ( whichone == 45 && len_nom > length_ligne_writedecl )
+   {
+      length_ligne_writedecl = len_nom;
+      if ( length_ligne_writedecl > LONG_M )
+           printf("WARNING 45 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_writedecl+100);
+   }
+   if ( whichone == 46 && len_nom > length_newname_toamr )
+   {
+      length_newname_toamr = len_nom;
+      if ( length_newname_toamr > LONG_C )
+           printf("WARNING 46 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_newname_toamr+100);
+   }
+   if ( whichone == 47 && len_nom > length_newname_writedecl )
+   {
+      length_newname_writedecl = len_nom;
+      if ( length_newname_writedecl > LONG_M )
+           printf("WARNING 47 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_newname_writedecl +100);
+   }
+   if ( whichone == 48 && len_nom > length_ligne_toamr )
+   {
+      length_ligne_toamr = len_nom;
+      if ( length_ligne_toamr > LONG_M )
+           printf("WARNING 48 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_toamr +100);
+   }
+   if ( whichone == 49 && len_nom > length_tmpligne_writedecl )
+   {
+      length_tmpligne_writedecl = len_nom;
+      if ( length_tmpligne_writedecl > LONG_M )
+           printf("WARNING 49 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpligne_writedecl+100);
+   }
+}
+
+void Save_Length_int(int val, int whichone)
+{
+   if ( whichone == 1 && val > value_char_size )    value_char_size  = val;
+   if ( whichone == 2 && val > value_char_size1 )   value_char_size1 = val;
+   if ( whichone == 3 && val > value_char_size2 )   value_char_size2 = val;
+   if ( whichone == 4 && val > value_char_size3 )   value_char_size3 = val;
+}
Index: vendors/AGRIF/LIB/WorkWithlistofcoupled.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithlistofcoupled.c	(revision 9621)
@@ -0,0 +1,105 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or    or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)           */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "decl.h"
+
+/******************************************************************************/
+/*                          variscoupled_0                                    */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int variscoupled_0(const char *ident)
+{
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(ident, coupletmp->c_namevar) &&
+                     !strcasecmp(subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    out = 1;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    return out;
+}
+
+const char * getcoupledname_0(const char *ident)
+{
+    listvarpointtovar *pointtmplist; 
+    listcouple *coupletmp;   
+    int out = 0;
+    
+    if (firstpass == 0 )
+    {
+        pointtmplist = List_CouplePointed_Var;
+        while ( pointtmplist && out == 0)
+        {
+            coupletmp = pointtmplist->t_couple;
+            while ( coupletmp && out == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(coupletmp->c_namevar,ident) &&
+                     !strcasecmp(pointtmplist->t_cursubroutine,subroutinename) &&
+                      strcasecmp(coupletmp->c_namepointedvar,"") )
+                {
+                    return coupletmp->c_namepointedvar;
+                }
+                coupletmp = coupletmp->suiv;
+            }
+            pointtmplist = pointtmplist->suiv;
+        }
+    }
+    printf("end of getcoupledname_0 -- you should not be there !!! \n");
+    return NULL;
+}
Index: vendors/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c	(revision 9621)
@@ -0,0 +1,303 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "decl.h"
+
+
+
+/******************************************************************************/
+/*                    RecordUseModulesVariables                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void RecordUseModulesVariables()
+{
+  listusemodule *tmplistmodule;
+
+  /* we should record all variables defined in modules used in this file      */
+  if ( List_NameOfModuleUsed )
+  {
+     tmplistmodule = List_NameOfModuleUsed;
+     while ( tmplistmodule )
+     {
+        if ( tmplistmodule->u_firstuse == 1 )
+        {
+           /* check if the file .depend<u_usemodule> exist                    */
+           List_ModuleUsed_Var = Readthedependfile
+                               (tmplistmodule->u_usemodule,List_ModuleUsed_Var);
+           List_GlobParamModuleUsed_Var = ReaddependParameterList
+                      (tmplistmodule->u_usemodule,List_GlobParamModuleUsed_Var);
+
+        }
+
+        tmplistmodule = tmplistmodule->suiv;
+     }
+  }
+}
+
+/******************************************************************************/
+/*                RecordUseModulesUseModulesVariables                         */
+/******************************************************************************/
+/******************************************************************************/
+void RecordUseModulesUseModulesVariables()
+{
+    listusemodule *tmplistmodule;
+    listusemodule *save_list;
+
+    if ( ! List_NameOfModuleUsed )  return;
+
+    /* we should record all variables defined in modules used in this file      */
+    /* and we should read the .depend of the module used by the module used  */
+    tmplistmodule = List_NameOfModuleUsed;
+    while ( tmplistmodule )
+    {
+        Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
+        while( tmpuselocallist )
+        {
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
+        }
+        tmplistmodule = tmplistmodule->suiv;
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
+        Readthedependlistofmoduleused(tmplistmodule->u_usemodule);
+        while( tmpuselocallist )
+        {
+            Addmoduletothelisttmp(tmpuselocallist->u_usemodule);
+            save_list = tmpuselocallist->suiv;
+            free(tmpuselocallist);
+            tmpuselocallist = save_list;
+        }
+        tmplistmodule = tmplistmodule->suiv;
+    }
+    tmplistmodule = listofmoduletmp;
+    while ( tmplistmodule )
+    {
+        // check if the file .depend<u_usemodule> exists
+        List_ModuleUsedInModuleUsed_Var =
+            Readthedependfile(tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var);
+
+        List_GlobParamModuleUsedInModuleUsed_Var =
+            ReaddependParameterList(tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var);
+        tmplistmodule = tmplistmodule->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                      Add_NameOfModuleUsed_1                                */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/* listusemodule                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... USE mod1 ===> insert in list                      */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  List_NameOfModuleUsed                                        */
+/*                                                                            */
+/******************************************************************************/
+void Add_NameOfModuleUsed_1(char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_modulename, curmodulename);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( List_NameOfModuleUsed == NULL )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours = parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
+}
+
+/******************************************************************************/
+/*                        Addmoduletothelist                                  */
+/******************************************************************************/
+/* This subroutine is used to add a record to a list of struct                */
+/* listusemodule                                                              */
+/******************************************************************************/
+/*                                                                            */
+/*       subroutine sub ... USE mod1 ===> insert in list                      */
+/*        _______     _______     _______     _______     _______             */
+/*       +      +    +      +    +      +    +      +    +      +             */
+/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
+/*       +______+    +______+    +______+    +______+    +______+             */
+/*                                                                            */
+/*       list =  List_NameOfModuleUsed                                     */
+/*                                                                            */
+/******************************************************************************/
+void Addmoduletothelist(const char *name)
+{
+    listusemodule *newmodule;
+    listusemodule *parcours;
+    int out;
+
+    newmodule = (listusemodule*) calloc(1,sizeof(listusemodule));
+    strcpy(newmodule->u_usemodule, name);
+    strcpy(newmodule->u_charusemodule, charusemodule);
+    strcpy(newmodule->u_cursubroutine, subroutinename);
+    newmodule->u_firstuse = 1 ;
+    newmodule->suiv = NULL;
+
+    if ( !List_NameOfModuleUsed )
+    {
+        List_NameOfModuleUsed = newmodule ;
+    }
+    else
+    {
+        parcours = List_NameOfModuleUsed;
+        while ( parcours && newmodule->u_firstuse == 1 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) )
+            {
+                newmodule->u_firstuse = 0 ;
+            }
+            parcours=parcours->suiv;
+        }
+        /* we can not add the same module twice for the same subroutine           */
+        parcours = List_NameOfModuleUsed;
+        out = 0 ;
+        while ( parcours && out == 0 )
+        {
+            if ( !strcasecmp(name,parcours->u_usemodule) &&
+                 !strcasecmp(subroutinename,parcours->u_cursubroutine) )
+            {
+                out = 1 ;
+                free(newmodule);
+            }
+            else
+                parcours=parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+            newmodule->suiv = List_NameOfModuleUsed;
+            List_NameOfModuleUsed = newmodule;
+        }
+    }
+}
+
+
+/******************************************************************************/
+/*                        WriteUsemoduleDeclaration                           */
+/******************************************************************************/
+/* Firstpass 0                                                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void WriteUsemoduleDeclaration(const char *cursubroutinename)
+{
+    listusemodule     *newmodule;
+    listvarpointtovar *pointtmp;
+    long int          fictifpos;
+    int               findcoupled;
+
+    fprintf(fortran_out,"\n");
+    newmodule = List_NameOfModuleUsed;
+
+    while ( newmodule )
+    {
+        if ( !strcasecmp(newmodule->u_cursubroutine, cursubroutinename) )
+        {
+            if (strcmp(newmodule->u_charusemodule,""))
+            {
+/*
+                findcoupled = 0;
+                pointtmp = List_CouplePointed_Var;
+                while(pointtmp)
+                {
+                    if ((!strcasecmp(pointtmp->t_usemodule, newmodule->u_charusemodule)) && \
+                        (!strcasecmp(pointtmp->t_cursubroutine, cursubroutinename)))
+                    {
+                        fictifpos = setposcur();
+                        variableisglobalinmodule(pointtmp->t_couple,newmodule->u_charusemodule,fortran_out,fictifpos);
+                        findcoupled = 1;
+                    }
+                    pointtmp=pointtmp->suiv;
+                }
+                if (findcoupled == 0)   fprintf(fortran_out,"      use %s\n",newmodule->u_charusemodule);
+*/
+                fprintf(fortran_out,"      use %s\n", newmodule->u_charusemodule);
+            }
+        }
+        newmodule = newmodule ->suiv;
+    }
+}
Index: vendors/AGRIF/LIB/WorkWithlistvarindoloop.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithlistvarindoloop.c	(revision 9621)
@@ -0,0 +1,1870 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or    or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)           */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+//#include <stdlib.h>
+//#include <string.h>
+
+#include "decl.h"
+
+/******************************************************************************/
+/*                         Add_UsedInSubroutine_Var_1                         */
+/******************************************************************************/
+/* Firstpass 1                                                                */
+/* We should complete the List_UsedInSubroutine_Var                           */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Add_UsedInSubroutine_Var_1 (const char *ident)
+{
+  listvar *newvar;
+  listvar *tmpvar;
+  int out;
+
+   /* In the first pass we record all variables presents in the do loop       */
+   if (firstpass == 1 && insubroutinedeclare == 1 )
+   {
+
+  if ( !List_UsedInSubroutine_Var )
+  {
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
+      /*                                                                      */
+      Init_Variable(newvar->var);
+      /*                                                                      */
+      newvar->suiv = NULL;
+      strcpy(newvar->var->v_nomvar,ident);
+      strcpy(newvar->var->v_modulename,curmodulename);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
+      strcpy(newvar->var->v_subroutinename,subroutinename);
+      newvar->var->v_pointedvar=pointedvar;
+      List_UsedInSubroutine_Var = newvar ;
+  }
+  else
+  {
+      /* We should verify that this variable did not added                    */
+      tmpvar = List_UsedInSubroutine_Var;
+      out = 0 ;
+      while (tmpvar && out == 0 )
+      {
+         if ( !strcasecmp(tmpvar->var->v_nomvar,ident) &&
+              !strcasecmp(tmpvar->var->v_subroutinename,subroutinename))
+                                                                      out  = 1 ;
+         else tmpvar = tmpvar->suiv;
+      }
+      if ( out == 0 )
+      {
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         strcpy(newvar->var->v_nomvar,ident);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
+         strcpy(newvar->var->v_modulename,curmodulename);
+         strcpy(newvar->var->v_subroutinename,subroutinename);
+         newvar->var->v_pointedvar=pointedvar;
+         newvar->suiv = List_UsedInSubroutine_Var;
+         List_UsedInSubroutine_Var = newvar;
+      }
+  }
+
+   }
+}
+
+/******************************************************************************/
+/*                        AJOUTEVARINDOLOOP_DEFINEDIMENSION                   */
+/******************************************************************************/
+/* This subroutine is used to add a listvar to  List_UsedInSubroutine_Var     */
+/******************************************************************************/
+void ajoutevarindoloop_definedimension (char *name)
+{
+  listvar *newvar;
+  listvar *tmpvar;
+  listvar *tmpvarprec;
+  int out;
+  int tablemeet;
+
+  if ( !List_UsedInSubroutine_Var )
+  {
+      newvar=(listvar *)calloc(1,sizeof(listvar));
+      newvar->var=(variable *)calloc(1,sizeof(variable));
+      /*                                                                      */
+      Init_Variable(newvar->var);
+      /*                                                                      */
+      newvar->suiv = NULL;
+      strcpy(newvar->var->v_nomvar,name);
+      strcpy(newvar->var->v_modulename,curmodulename);
+      strcpy(newvar->var->v_commoninfile,cur_filename);
+      strcpy(newvar->var->v_subroutinename,subroutinename);
+      newvar->var->v_pointedvar=pointedvar;
+      List_UsedInSubroutine_Var = newvar ;
+  }
+  else
+  {
+      /* We should verify that this variable did not added                    */
+      tmpvarprec = (listvar *)NULL;
+      tmpvar = List_UsedInSubroutine_Var;
+      out = 0 ;
+      tablemeet = 0 ;
+      while (tmpvar && out == 0 )
+      {
+         if ( tablemeet == 0 && tmpvar->var->v_nbdim != 0 ) tablemeet = 1 ;
+         /*                                                                   */
+         if ( !strcasecmp(tmpvar->var->v_nomvar,name) &&
+              !strcasecmp(tmpvar->var->v_subroutinename,subroutinename))
+         {
+            out  = 1 ;
+            /* if this variable has been define before a table we do nothing  */
+            /*    else we should remove it                                    */
+            if ( tablemeet == 1 )
+            {
+               tmpvarprec->suiv = tmpvar -> suiv;
+               out = 2;
+            }
+         }
+         else
+         {
+            tmpvarprec = tmpvar;
+            tmpvar = tmpvar->suiv;
+         }
+      }
+      if ( out == 2 || out == 0 )
+      {
+         newvar=(listvar *)calloc(1,sizeof(listvar));
+         newvar->var=(variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         strcpy(newvar->var->v_nomvar,name);
+         strcpy(newvar->var->v_modulename,curmodulename);
+         strcpy(newvar->var->v_commoninfile,cur_filename);
+         strcpy(newvar->var->v_subroutinename,subroutinename);
+         newvar->var->v_pointedvar=pointedvar;
+
+         /* we should find this new variable to know the tabvars indice       */
+         if ( variableisglobal(newvar, List_Global_Var) == 1 )
+         {
+            newvar->suiv = List_UsedInSubroutine_Var;
+            List_UsedInSubroutine_Var = newvar;
+         }
+         else if ( variableisglobal(newvar, List_ModuleUsed_Var) == 1 )
+         {
+            newvar->suiv = List_UsedInSubroutine_Var;
+            List_UsedInSubroutine_Var = newvar;
+         }
+         else if ( variableisglobal(newvar, List_Common_Var) == 1 )
+         {
+            newvar->suiv = List_UsedInSubroutine_Var;
+            List_UsedInSubroutine_Var = newvar;
+         }
+         else
+         {
+            free(newvar);
+         }
+     }
+  }
+}
+
+/******************************************************************************/
+/*                        ModifyThelistvarindoloop                            */
+/******************************************************************************/
+/* This subroutine is to give the old name to the which has been              */
+/* declared as USE MOD, U => V in this case we should replace in the          */
+/* name V by the old name U in the List_UsedInSubroutine_Var                  */
+/******************************************************************************/
+void  ModifyThelistvarindoloop()
+{
+  listvar *newvar;
+
+  newvar = List_UsedInSubroutine_Var;
+  while ( newvar )
+  {
+     if ( strcasecmp(newvar->var->v_oldname,"") )
+     {
+        strcpy(newvar->var->v_nomvar,newvar->var->v_oldname);
+     }
+     newvar = newvar->suiv;
+  }
+}
+
+/******************************************************************************/
+/*                          CompleteThelistvarindoloop                        */
+/******************************************************************************/
+/* This subroutine is to add to the List_UsedInSubroutine_Var all variables   */
+/* which has been declared as USE MOD, U => V in this case we should replace  */
+/* in the List_UsedInSubroutine_Var the word U by the word V                  */
+/******************************************************************************/
+void  CompleteThelistvarindoloop()
+{
+    listvar *newvar;
+    listvarpointtovar *pointtmplist;
+    listcouple *coupletmp;
+    int outvar;
+
+    pointtmplist = List_CouplePointed_Var;
+    while ( pointtmplist )
+    {
+        coupletmp = pointtmplist->t_couple;
+        while ( coupletmp )
+        {
+            newvar = List_UsedInSubroutine_Var;
+            outvar = 0 ;
+            while ( newvar && outvar == 0)
+            {
+                /* we should find the same variable name in the same subroutine    */
+                if ( !strcasecmp(newvar->var->v_nomvar, coupletmp->c_namevar) &&
+                     !strcasecmp(newvar->var->v_subroutinename, pointtmplist->t_cursubroutine) &&
+                      strcasecmp(coupletmp->c_namepointedvar, "") )
+                {
+                    outvar = 1;
+                    strcpy(newvar->var->v_oldname, newvar->var->v_nomvar);
+                    strcpy(newvar->var->v_nomvar, coupletmp->c_namepointedvar);
+                }
+                else
+                {
+                    newvar = newvar->suiv;
+                }
+            }
+            coupletmp = coupletmp->suiv;
+        }
+        pointtmplist = pointtmplist->suiv;
+    }
+}
+
+/******************************************************************************/
+/*                             Merge_Variables                                */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Merge_Variables(variable *var1, variable *var2)
+{
+    if ( !strcasecmp(var1->v_typevar,"") )
+            strcpy(var1->v_typevar,var2->v_typevar);
+    else
+      {
+      strcpy(var2->v_typevar,var1->v_typevar);
+      }
+
+    if ( !strcasecmp(var1->v_oldname,"") )
+            strcpy(var1->v_oldname,var2->v_oldname);
+    else    strcpy(var2->v_oldname,var1->v_oldname);
+
+    if ( !strcasecmp(var1->v_dimchar,"") )
+            strcpy(var1->v_dimchar,var2->v_dimchar);
+    else    strcpy(var2->v_dimchar,var1->v_dimchar);
+
+    if ( !strcasecmp(var1->v_commonname,"") )
+            strcpy(var1->v_commonname,var2->v_commonname);
+    else    strcpy(var2->v_commonname,var1->v_commonname);
+
+    if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
+            strcpy(var1->v_modulename,var2->v_modulename);
+    else    strcpy(var2->v_modulename,var1->v_modulename);
+
+    if ( !strcasecmp(var1->v_vallengspec,"") )
+            strcpy(var1->v_vallengspec,var2->v_vallengspec);
+    else    strcpy(var2->v_vallengspec,var1->v_vallengspec);
+
+    if ( !strcasecmp(var1->v_nameinttypename,"") )
+            strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
+    else    strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
+
+    if ( !strcasecmp(var1->v_commoninfile,"") )
+            strcpy(var1->v_commoninfile,var2->v_commoninfile);
+    else    strcpy(var2->v_commoninfile,var1->v_commoninfile);
+
+    if ( !strcasecmp(var1->v_precision,"") )
+            strcpy(var1->v_precision,var2->v_precision);
+    else    strcpy(var2->v_precision,var1->v_precision);
+
+    if ( !strcasecmp(var1->v_initialvalue,"") )
+            strcpy(var1->v_initialvalue,var2->v_initialvalue);
+    else    strcpy(var2->v_initialvalue,var1->v_initialvalue);
+
+    if ( !strcasecmp(var1->v_IntentSpec,"") )
+            strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
+    else    strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
+
+    if ( !strcasecmp(var1->v_readedlistdimension,"") )
+            strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
+    else    strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
+
+    if ( var1->v_dimension )
+            var2->v_dimension = var1->v_dimension ;
+    else    var1->v_dimension = var2->v_dimension ;
+
+    if ( var1->v_nbdim == 0 )
+            var1->v_nbdim = var2->v_nbdim ;
+    else    var2->v_nbdim = var1->v_nbdim ;
+
+    if ( var1->v_common == 0 )
+            var1->v_common = var2->v_common ;
+    else    var2->v_common = var1->v_common ;
+
+    if ( var1->v_positioninblock == 0 )
+            var1->v_positioninblock = var2->v_positioninblock ;
+    else    var2->v_positioninblock = var1->v_positioninblock ;
+
+    if ( var1->v_module == 0 )
+            var1->v_module = var2->v_module ;
+    else    var2->v_module = var1->v_module ;
+
+    if ( var1->v_save == 0 )
+            var1->v_save = var2->v_save ;
+    else    var2->v_save = var1->v_save ;
+
+    if ( var1->v_VariableIsParameter == 0 )
+            var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
+    else    var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
+
+    if ( var1->v_indicetabvars == 0 )
+            var1->v_indicetabvars = var2->v_indicetabvars ;
+    else    var2->v_indicetabvars = var1->v_indicetabvars ;
+
+    if ( var1->v_ExternalDeclare == 0 )
+            var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
+    else    var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
+
+    if ( var1->v_pointedvar == 0 )
+            var1->v_pointedvar = var2->v_pointedvar ;
+    else    var2->v_pointedvar = var1->v_pointedvar ;
+
+    if ( var1->v_dimensiongiven == 0 )
+            var1->v_dimensiongiven = var2->v_dimensiongiven;
+    else    var2->v_dimensiongiven = var1->v_dimensiongiven ;
+
+    if ( var1->v_c_star == 0 )
+            var1->v_c_star = var2->v_c_star;
+    else    var2->v_c_star = var1->v_c_star ;
+
+    if ( var1->v_catvar == 0 )
+            var1->v_catvar = var2->v_catvar;
+    else    var2->v_catvar = var1->v_catvar ;
+
+    if ( var1->v_pointerdeclare == 0 )
+            var1->v_pointerdeclare = var2->v_pointerdeclare ;
+    else    var2->v_pointerdeclare = var1->v_pointerdeclare ;
+
+    if ( var1->v_notgrid == 0 )
+            var1->v_notgrid = var2->v_notgrid ;
+    else    var2->v_notgrid = var1->v_notgrid;
+
+    if ( var1->v_optionaldeclare == 0 )
+            var1->v_optionaldeclare = var2->v_optionaldeclare;
+    else    var2->v_optionaldeclare = var1->v_optionaldeclare ;
+
+    if ( var1->v_allocatable == 0 )
+            var1->v_allocatable = var2->v_allocatable ;
+    else    var2->v_allocatable = var1->v_allocatable ;
+
+    if ( var1->v_target == 0 )
+            var1->v_target = var2->v_target ;
+    else    var2->v_target = var1->v_target ;
+
+    if ( var1->v_dimsempty == 0 )
+            var1->v_dimsempty = var2->v_dimsempty ;
+    else    var2->v_dimsempty = var1->v_dimsempty ;
+}
+
+
+/******************************************************************************/
+/*                      Update_List_Subroutine_Var                            */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_Subroutine_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   listvar *parcours1;
+   int out;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = list_to_modify;
+   while( parcours )
+   {
+      /* looking in List_SubroutineDeclaration_Var                            */
+      parcours1 = List_SubroutineDeclaration_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar)         &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_modulename,     parcours1->var->v_modulename)
+            ) out = 1;
+         else parcours1 = parcours1->suiv;
+      }
+      /* if variable has been found                                           */
+
+      if ( out == 1 ) Merge_Variables(parcours->var,parcours1->var);
+
+      /* looking in List_Dimension_Var                                        */
+      if (out == 0 )
+      {
+        parcours1 = List_Dimension_Var;
+        out = 0;
+        while ( parcours1 && out == 0 )
+        {
+           if ( !strcasecmp(parcours->var->v_nomvar,
+                            parcours1->var->v_nomvar)         &&
+                !strcasecmp(parcours->var->v_subroutinename,
+                            parcours1->var->v_subroutinename) &&
+                !strcasecmp(parcours->var->v_modulename,
+                            parcours1->var->v_modulename)
+              ) out = 1;
+           else
+           {
+              parcoursprec = parcours1;
+              parcours1 = parcours1->suiv;
+           }
+        }
+        /* if variable has been found                                         */
+
+        if ( out == 1 )
+        {
+           Merge_Variables(parcours->var,parcours1->var);
+           /* we should remove this record from the List_Dimension_Var        */
+           if ( parcours1 == List_Dimension_Var )
+           {
+              List_Dimension_Var = List_Dimension_Var -> suiv;
+           }
+           else
+           {
+              parcoursprec->suiv = parcours1 -> suiv;
+           }
+        }
+      }
+      /*                                                                      */
+      parcours = parcours->suiv;
+   }
+}
+
+void Update_List_Global_Var_From_List_Save_Var()
+{
+   listvar *parcours;
+   listvar *newvar;
+   char tmpname[LONG_VNAME];
+
+   parcours = List_Save_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,"") )
+      /* Save in subroutine which is not defined in a module                  */
+      {
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         newvar->suiv = NULL;
+         Merge_Variables(parcours->var,newvar->var);
+         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+         newvar->var->v_catvar=parcours->var->v_catvar;
+         sprintf(tmpname,"save_%s",parcours->var->v_subroutinename);
+         Add_NameOfCommon_1(tmpname,parcours->var->v_subroutinename);
+         strcpy(newvar->var->v_commonname,tmpname);
+         List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1);
+      }
+      else
+      /* Save in subroutine which is defined in a module                      */
+      {
+         newvar = (listvar *)calloc(1,sizeof(listvar));
+         newvar->var = (variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(newvar->var);
+         /*                                                                   */
+         newvar->suiv = NULL;
+
+         Merge_Variables(parcours->var,newvar->var);
+         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
+
+         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
+
+         newvar->var->v_catvar=parcours->var->v_catvar;
+         strcpy(newvar->var->v_modulename,parcours->var->v_modulename);
+         List_Global_Var = AddListvarToListvar(newvar,List_Global_Var,1);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+/******************************************************************************/
+/*                      Update_List_From_Common_Var                           */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_From_Common_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int out;
+   parcours = list_to_modify;
+   while( parcours )
+   {
+      /* looking in List_Global_Var                                           */
+      parcours1 = List_Common_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+
+         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar) &&
+              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) )
+         {
+            out = 1;
+         }
+         else parcours1 = parcours1->suiv;
+      }
+      /* if variable has been found                                           */
+      if ( out == 1 )
+      {
+         strcpy(parcours->var->v_commoninfile,parcours1->var->v_commoninfile);
+
+         Merge_Variables(parcours->var,parcours1->var);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+/******************************************************************************/
+/*                          Update_List_Var                                   */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_List_Var(listvar *list_to_modify)
+{
+    listvar *parcours;
+    listvar *parcours1;
+    int out;
+
+    parcours = list_to_modify;
+
+    while( parcours )
+    {
+        /*printf("LE NOM EST %s\n",parcours->var->v_nomvar);*/
+        /* looking in List_Global_Var                                           */
+        out = 0;
+        parcours1 = List_Global_Var;
+
+        while ( parcours1 && out == 0 )
+        {
+            if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)         &&
+                 !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+            {
+                out = 1;
+            }
+            else parcours1 = parcours1->suiv;
+        }
+
+        /* if variable has been found                                           */
+        if ( out == 1 )
+        {
+            Merge_Variables(parcours->var,parcours1->var);
+        }
+        /* looking in List_SubroutineDeclaration_Var                            */
+        else
+        {
+            parcours1 = List_SubroutineDeclaration_Var ;
+            out = 0;
+            while ( parcours1 )
+            {
+                if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                     !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                     !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                {
+                    out = 1;
+                    break;
+                }
+                else parcours1 = parcours1->suiv;
+            }
+            /* if variable has been found                                        */
+            if ( out == 1 )
+            {
+                Merge_Variables(parcours->var,parcours1->var);
+            }
+            else
+            {
+                parcours1 = List_Common_Var ;
+                out = 0;
+                while ( parcours1 && out == 0 )
+                {
+                    if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
+                         !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
+                         !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
+                    {
+                        out = 1;
+                    }
+                    else parcours1 = parcours1->suiv;
+                }
+                /* if variable has been found                                     */
+                if ( out == 1 )
+                {
+                    Merge_Variables(parcours->var,parcours1->var);
+                }
+            }
+        }
+        parcours = parcours->suiv;
+    }
+}
+
+
+void List_UsedInSubroutine_Var_Update_From_Module_Used()
+{
+   listvar *parcours;
+   listvar *parcours3;
+   listusemodule *parcours2;
+   int out;
+
+
+   parcours = List_UsedInSubroutine_Var;
+   while( parcours )
+   {
+      out = 0 ;
+      if ( parcours->var->v_indicetabvars == 0 )
+      {
+         parcours2 = List_NameOfModuleUsed;
+         while( parcours2 )
+         {
+            if ( !strcasecmp(parcours2->u_cursubroutine, "") &&
+                 !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) )
+            {
+               parcours3 = List_Global_Var;
+               out = 0 ;
+               while ( parcours3 && out == 0 )
+               {
+                  if ( !strcasecmp(parcours->var->v_nomvar,
+                                   parcours3->var->v_nomvar)
+                     ) out = 1 ;
+                  else parcours3 = parcours3->suiv;
+               }
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
+            }
+            else if ( !strcasecmp(parcours2->u_cursubroutine, parcours->var->v_subroutinename) &&
+                      !strcasecmp(parcours2->u_modulename,    parcours->var->v_modulename) )
+            {
+               parcours3 = List_Global_Var;
+               out = 0 ;
+               while ( parcours3 && out == 0 )
+               {
+                  if ( !strcasecmp(parcours->var->v_nomvar,
+                                   parcours3->var->v_nomvar)
+                     ) out = 1 ;
+                  else parcours3 = parcours3->suiv;
+               }
+               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
+            }
+            parcours2 = parcours2->suiv;
+         }
+         /*                                                                   */
+         if ( out == 0 )
+         {
+            parcours3 = List_ModuleUsed_Var;
+            out = 0 ;
+            while ( parcours3 && out == 0 )
+            {
+               if ( !strcasecmp(parcours->var->v_nomvar,
+                                parcours3->var->v_nomvar)
+                  ) out = 1 ;
+               else parcours3 = parcours3->suiv;
+            }
+            if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
+         }
+         /*                                                                   */
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+
+
+/******************************************************************************/
+/*                       Update_NotGridDepend_Var                             */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void Update_NotGridDepend_Var(listvar *list_to_modify)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int out;
+
+   parcours = list_to_modify;
+   while( parcours )
+   {
+      /* looking in List_Global_Var                                           */
+      parcours1 = List_Global_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                          parcours1->var->v_nomvar)
+            ) out = 1;
+         else parcours1 = parcours1->suiv;
+      }
+      /* if variable has been found                                           */
+      if ( out == 1 )
+      {
+         Merge_Variables(parcours->var,parcours1->var);
+         strcpy(parcours->var->v_subroutinename,
+                parcours1->var->v_subroutinename);
+         strcpy(parcours->var->v_modulename,parcours1->var->v_modulename);
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+int LookingForVariableInList(listvar *listin,variable *var)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
+           !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&&
+           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)        &&
+                       var->v_save == 0                                       &&
+                       var->v_common == 0
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+int LookingForVariableInListGlobal(listvar *listin,variable *var)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
+           !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&&
+           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+int LookingForVariableInListName(listvar *listin,const char *name)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(name,parcours1->var->v_nomvar) &&
+           ( !strcasecmp(subroutinename,parcours1->var->v_subroutinename) ||
+             !strcasecmp(subroutinename,"") )
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+variable *get_variable_in_list_from_name( listvar *listin, const char *name )
+{
+    listvar *parcours = listin;
+    variable *var = NULL;
+
+    while ( parcours && (!var) )
+    {
+        if ( !strcasecmp(name,parcours->var->v_nomvar) &&
+           ( !strcasecmp(subroutinename,parcours->var->v_subroutinename) ||
+             !strcasecmp(subroutinename,"") ) )
+        {
+            var = parcours->var;
+        }
+        else parcours = parcours -> suiv;
+   }
+   return var;
+}
+
+int LookingForVariableInListGlob(listvar *listin,variable *var)
+{
+   listvar *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
+           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+int LookingForVariableInListParamGlob(listparameter *listin,variable *var)
+{
+   listparameter *parcours1;
+   int out;
+
+   parcours1 = listin;
+   out = 0 ;
+   while ( parcours1 && out == 0 )
+   {
+      if ( !strcasecmp(var->v_nomvar,parcours1->p_name)
+         ) out = 1 ;
+      else parcours1 = parcours1 -> suiv;
+   }
+
+   return out;
+}
+
+void UpdateListDeclarationWithDimensionList()
+{
+   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, List_SubroutineDeclaration_Var,1);
+}
+
+
+/* Remove from List_UsedInSubroutine_Var all variables comming from :         */
+/*       - List_SubroutineArgument_Var                                        */
+/*       - List_SubroutineDeclaration_Var                                     */
+/*       - List_Parameter_Var                                                 */
+/*       - List_FunctionType_Var                                              */
+/*       - List_GlobalParameter_Var                                           */
+/*       -                                                                    */
+/*       -                                                                    */
+void Clean_List_UsedInSubroutine_Var()
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   int remove;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = List_UsedInSubroutine_Var;
+   while ( parcours )
+   {
+      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,   parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInList(List_SubroutineDeclaration_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInList(List_Parameter_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInList(List_FunctionType_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInListGlob(List_GlobalParameter_Var, parcours->var);
+      if ( remove == 0 )
+           remove = LookingForVariableInListParamGlob(List_GlobParamModuleUsed_Var, parcours->var);
+      if ( remove == 0 )
+      {
+         if ( VariableIsInList(parcours,List_Global_Var)                 == 1 ||
+              VariableIsInListCommon(parcours,List_Common_Var)           == 1 ||
+              VariableIsInList(parcours,List_ModuleUsed_Var)             == 1 ||
+              VariableIsInList(parcours,List_ModuleUsedInModuleUsed_Var) == 1
+            ) remove = 0;
+         else remove = 1;
+      }
+
+      /************************************************************************/
+      /*                         Remove                                       */
+      /************************************************************************/
+
+      if ( remove == 1 )
+      {
+         if ( parcours == List_UsedInSubroutine_Var )
+         {
+           List_UsedInSubroutine_Var = List_UsedInSubroutine_Var -> suiv;
+           parcours = List_UsedInSubroutine_Var;
+         }
+         else
+         {
+            parcoursprec->suiv = parcours->suiv;
+            parcours = parcoursprec -> suiv ;
+         }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours -> suiv ;
+      }
+   }
+}
+
+
+void Clean_List_ModuleUsed_Var()
+{
+   listvar *parcours;
+   listvar *parcours1;
+   listvar *parcoursprec;
+   int remove;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = List_ModuleUsed_Var;
+   while ( parcours )
+   {
+      /*                                                                      */
+      parcours1 = List_GlobalParameter_Var;
+      remove = 0 ;
+      while ( parcours1 && remove == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+            ) remove = 1 ;
+         else parcours1 = parcours1 -> suiv;
+      }
+      /************************************************************************/
+      /*                         Remove                                       */
+      /************************************************************************/
+      if ( remove == 1 )
+      {
+         if ( parcours == List_ModuleUsed_Var )
+         {
+           List_ModuleUsed_Var = List_ModuleUsed_Var -> suiv;
+           parcours = List_ModuleUsed_Var;
+         }
+         else
+         {
+            parcoursprec->suiv = parcours->suiv;
+            parcours = parcoursprec -> suiv ;
+         }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours -> suiv ;
+      }
+   }
+}
+
+void Clean_List_SubroutineDeclaration_Var()
+{
+   listvar *parcours;
+   listvar *parcours1;
+   listvar *parcoursprec;
+   int out ;
+
+   parcoursprec = (listvar *)NULL;
+   parcours = List_SubroutineDeclaration_Var;
+   while ( parcours )
+   {
+      parcours1 = List_FunctionType_Var;
+      out = 0 ;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+              !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+            ) out = 1;
+         else parcours1 = parcours1->suiv;
+      }
+      if ( out == 0 )
+      {
+         parcours1 = List_SubroutineArgument_Var;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
+                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+               ) out = 1;
+            else parcours1 = parcours1->suiv;
+         }
+      }
+
+      if ( out == 1 )
+      {
+          if ( parcours == List_SubroutineDeclaration_Var )
+          {
+             List_SubroutineDeclaration_Var =
+                                         List_SubroutineDeclaration_Var -> suiv;
+             parcours = List_SubroutineDeclaration_Var;
+          }
+          else
+          {
+             parcoursprec->suiv = parcours->suiv;
+             parcours = parcoursprec->suiv;
+          }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours -> suiv;
+      }
+   }
+}
+
+void Clean_List_Global_Var()
+{
+   listvar *parcours;
+   listvar *parcours2;
+   listvar *parcoursprec;
+   listvar *parcours2prec;
+
+   parcoursprec = (listvar *)NULL;
+   parcours2prec = (listvar *)NULL;
+   parcours = List_Global_Var;
+   while ( parcours )
+   {
+      if ( parcours->var->v_VariableIsParameter == 1 )
+      {
+         /* remove                                                            */
+         if ( parcours == List_Global_Var )
+         {
+            List_Global_Var = List_Global_Var->suiv;
+            free(parcours);
+            parcours = List_Global_Var;
+         }
+         else
+         {
+            parcoursprec->suiv = parcours->suiv;
+            free(parcours);
+            parcours = parcoursprec->suiv;
+         }
+      }
+      else
+      {
+         parcoursprec = parcours;
+         parcours = parcours->suiv;
+      }
+   }
+   /* looking for sevral declaration of the same variable                     */
+   parcours = List_Global_Var;
+   while ( parcours )
+   {
+      parcours2prec = parcours;
+      parcours2 = parcours->suiv;
+      while ( parcours2 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                         parcours2->var->v_nomvar)     &&
+              !strcasecmp(parcours->var->v_modulename,
+                         parcours2->var->v_modulename) )
+         {
+            Merge_Variables(parcours->var,parcours2->var);
+            /* remove var from the parcours2                                  */
+            parcours2prec ->suiv = parcours2->suiv;
+            free(parcours2);
+            parcours2 = parcours2prec ->suiv;
+         }
+         else
+         {
+            parcours2prec = parcours2;
+            parcours2 = parcours2->suiv;
+         }
+      }
+      parcours = parcours->suiv;
+   }
+}
+/******************************************************************************/
+/*                             ListClean                                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void ListClean()
+{
+   listvar *newvar;
+
+   Clean_List_ModuleUsed_Var();
+   Clean_List_UsedInSubroutine_Var();
+   Clean_List_SubroutineDeclaration_Var();
+
+   newvar = (listvar *)NULL;
+/*   newvar = List_Common_Var;*/
+   while(newvar)
+   {
+      printf("----- %s --- %s ---%s---%s---\n",newvar->var->v_nomvar,
+         newvar->var->v_commonname,
+         newvar->var->v_readedlistdimension,
+         newvar->var->v_subroutinename
+      );
+      newvar = newvar -> suiv;
+      printf("+++++++++++++++++++++++++\n");
+   }
+
+}
+
+
+/******************************************************************************/
+/*                             ListUpdate                                     */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void ListUpdate()
+{
+    listvar *newvar;
+
+    Update_List_Subroutine_Var(List_SubroutineArgument_Var);
+    Update_List_Subroutine_Var(List_FunctionType_Var);
+    Update_List_Var(List_Parameter_Var);
+    Update_List_Var(List_Dimension_Var);
+    Update_List_Var(List_Data_Var);
+    Update_List_Var(List_Save_Var);
+    Update_List_Var(List_GlobalParameter_Var);
+    Update_List_Var(List_Common_Var);
+    Update_List_Var(List_SubroutineDeclaration_Var);
+    Update_List_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_UsedInSubroutine_Var);
+    Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
+    Update_NotGridDepend_Var(List_NotGridDepend_Var);
+
+    newvar = (listvar * ) NULL;
+//   newvar = List_Common_Var;
+//   newvar = List_UsedInSubroutine_Var;
+//   newvar = List_Data_Var;
+    while ( newvar )
+    {
+        printf("++++ %s - %s - %s - %d - %s - %s\n",
+                newvar->var->v_modulename,
+                newvar->var->v_subroutinename,
+                newvar->var->v_nomvar,
+                newvar->var->v_VariableIsParameter,
+                newvar->var->v_typevar,
+                newvar->var->v_initialvalue );
+        newvar = newvar->suiv;
+    }
+}
+
+void GiveTypeOfVariables()
+{
+   listvar *parcours;
+
+   /*                                                                         */
+   parcours = List_Common_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+   /*                                                                         */
+   parcours = List_UsedInSubroutine_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+   /*                                                                         */
+   parcours = List_SubroutineArgument_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+   /*                                                                         */
+   parcours = List_SubroutineDeclaration_Var;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_typevar,"") )
+      {
+         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
+                                        strcpy(parcours->var->v_typevar,"REAL");
+         else strcpy(parcours->var->v_typevar,"INTEGER");
+      }
+      parcours = parcours -> suiv ;
+   }
+
+}
+
+
+
+void Sort_List_SubroutineArgument_Var()
+{
+   listvar *parcours;
+   listvar *parcours1;
+   int position;
+   int out;
+   char name_sub[LONG_M];
+
+   parcours = List_SubroutineArgument_Var;
+   position = 1;
+   while ( parcours )
+   {
+      parcours1 = List_SubroutineDeclaration_Var;
+      out = 0;
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_nomvar,
+                         parcours1->var->v_nomvar)  &&
+              !strcasecmp(parcours->var->v_subroutinename,
+                         parcours1->var->v_subroutinename)
+             )
+         {
+            parcours1->var->v_positioninblock = position;
+            position = position +1 ;
+            out = 1;
+         }
+         else parcours1 = parcours1->suiv;
+      }
+      parcours = parcours->suiv;
+   }
+   /*                                                                         */
+   parcours = List_SubroutineDeclaration_Var;
+   strcpy(name_sub,"");
+   while ( parcours )
+   {
+      if ( !strcasecmp(name_sub,"") )
+      {
+         strcpy(name_sub,parcours->var->v_subroutinename);
+         position = 1;
+      }
+
+      if ( parcours->var->v_positioninblock != 0 )
+      {
+         parcours1 = List_SubroutineArgument_Var;
+         out = 0;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,
+                            parcours1->var->v_nomvar)  &&
+                 !strcasecmp(parcours->var->v_subroutinename,
+                            parcours1->var->v_subroutinename)
+                )
+            {
+               parcours1->var->v_positioninblock = position;
+               position = position +1 ;
+               out = 1;
+            }
+            else parcours1 = parcours1->suiv;
+         }
+      }
+      if ( parcours->suiv )
+         if ( strcasecmp(name_sub,parcours->suiv->var->v_subroutinename) )
+            strcpy(name_sub,"");
+      parcours = parcours->suiv;
+   }
+
+}
+
+
+
+/******************************************************************************/
+/*                      IndiceTabvars_Global_Var_Treated                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Global_Var_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcoursprec;
+   listvar *parcours1;
+   listvar *List_ModuleUsed_Var;
+   listindice *newindice;
+   int out;
+
+   parcoursprec = (listvar *)NULL;
+
+   if ( todebug == 1 ) printf("MODULE Treated %s \n",nom);
+
+   List_ModuleUsed_Var = (listvar *)NULL;
+   List_ModuleUsed_Var = Readthedependfile(nom,List_ModuleUsed_Var);
+
+   parcours = List_Global_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,nom) )
+      {
+         parcours1 = List_ModuleUsed_Var;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+               ) out = 1;
+            else
+            {
+               parcoursprec = parcours1 ;
+               parcours1 = parcours1->suiv;
+            }
+         }
+         /* if we found the var Module name in the old list                   */
+         if ( out == 1 )
+         {
+            Merge_Variables(parcours->var,parcours1->var);
+            /* Remove this variable from the List_ModuleUsed_Var              */
+            if ( parcours1 == List_ModuleUsed_Var )
+            {
+               List_ModuleUsed_Var = List_ModuleUsed_Var->suiv ;
+            }
+            else
+            {
+               parcoursprec->suiv = parcours1->suiv;
+               free(parcours1);
+               parcours1 = parcoursprec->suiv;
+            }
+         }
+         else
+         /* if we do not found the var Module name in the old list            */
+         {
+  //       update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+  //          if ( Listofavailableindices )
+  //          {
+  //             parcours->var->v_indicetabvars = Listofavailableindices ->
+  //                                                                     i_indice;
+  //             if ( Listofavailableindices->suiv )
+  //                        Listofavailableindices = Listofavailableindices->suiv;
+  //             else
+  //                        Listofavailableindices = (listindice *)NULL;
+  //          }
+  //          else
+  //          {
+  //             indicemaxtabvars = indicemaxtabvars + 1 ;
+  //             parcours->var->v_indicetabvars = indicemaxtabvars;
+  //          }
+         }
+      }
+      parcours = parcours->suiv;
+   }
+   /* if List_ModuleUsed_Var is not empty, some var have been removed from    */
+   /*    the last treatement                                                  */
+  parcours1 = List_ModuleUsed_Var;
+  while ( parcours1 )
+  {
+     newindice=(listindice *) calloc(1,sizeof(listindice));
+     newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
+     newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+     Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
+     parcours1 = parcours1->suiv;
+  }
+}
+/******************************************************************************/
+/*                       IndiceTabvars_Global_Var_No_Treated                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Global_Var_No_Treated(char *nom)
+{
+   listvar *parcours;
+
+   if ( todebug == 1 ) printf("MODULE No Treated %s \n",nom);
+
+   parcours = List_Global_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_modulename,nom) &&
+           parcours->var->v_VariableIsParameter == 0    &&
+           parcours->var->v_notgrid == 0
+          )
+      {
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+
+void UpdateTheRemainingList(listvar *record)
+{
+   listvar *parcours;
+
+   parcours = record;
+   while ( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_nomvar,record->var->v_nomvar) &&
+           !strcasecmp(parcours->var->v_commonname,record->var->v_commonname)
+         )
+      {
+         strcpy(parcours->var->v_commoninfile,record->var->v_commoninfile);
+         Merge_Variables(parcours->var,record->var);
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+
+
+/******************************************************************************/
+/*                      IndiceTabvars_Common_Var_Treated                      */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Common_Var_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcours1;
+   listvar *List_CommonUsed_Var;
+   listindice *newindice;
+   int out;
+
+   if ( todebug == 1 ) printf("COMMON Treated %s \n",nom);
+
+   List_CommonUsed_Var = (listvar *)NULL;
+   List_CommonUsed_Var = Readthedependfile(nom,List_CommonUsed_Var);
+
+   parcours = List_Common_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_commonname,nom) )
+      {
+         parcours1 = List_CommonUsed_Var;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+
+            if ( !strcasecmp(parcours1->var->v_commonname,nom) &&
+                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
+               ) out = 1;
+            else
+            {
+               parcours1 = parcours1->suiv;
+            }
+         }
+         /* if we found the var common name in the old list                   */
+         if ( out == 1 )
+         {
+            strcpy(parcours->var->v_commoninfile,
+                   parcours1->var->v_commoninfile);
+            Merge_Variables(parcours->var,parcours1->var);
+         }
+         else
+         /* if we do not found the var common name in the old list            */
+         {
+    //     update_indicemaxtabvars(parcours->var,Listofavailableindices);
+         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
+    //        if ( Listofavailableindices )
+    //        {
+    //           parcours->var->v_indicetabvars = Listofavailableindices ->
+    //                                                                   i_indice;
+    //           if ( Listofavailableindices->suiv )
+    //                      Listofavailableindices = Listofavailableindices->suiv;
+    //           else
+    //                      Listofavailableindices = (listindice *)NULL;
+    //        }
+    //        else
+    //        {
+    //           indicemaxtabvars = indicemaxtabvars + 1 ;
+    //           parcours->var->v_indicetabvars = indicemaxtabvars;
+    //        }
+         }
+         /* Look in the remaining list in the variable is define              */
+         UpdateTheRemainingList(parcours);
+      }
+      parcours = parcours->suiv;
+   }
+   /* if List_CommonUsed_Var is not empty, some var have been removed from    */
+   /*    the last treatement                                                  */
+  parcours1 = List_CommonUsed_Var;
+  while ( parcours1 )
+  {
+     if ( parcours1 -> var -> v_indicetabvars == 0 )
+     {
+        newindice=(listindice *) calloc(1,sizeof(listindice));
+        newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
+        newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
+        Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
+     }
+     parcours1 = parcours1->suiv;
+  }
+}
+
+void update_indicemaxtabvars(variable *var,listindice **Listofindices)
+{
+
+
+            if ( Listofindices[var->v_catvar] )
+            {
+               var->v_indicetabvars = Listofindices[var->v_catvar] -> i_indice;
+               if ( Listofindices[var->v_catvar]->suiv )
+                          Listofindices[var->v_catvar] = Listofindices[var->v_catvar]->suiv;
+               else
+                          Listofindices[var->v_catvar] = (listindice *)NULL;
+            }
+            else
+            {
+               indicemaxtabvars[var->v_catvar] = indicemaxtabvars[var->v_catvar] + 1 ;
+               var->v_indicetabvars = indicemaxtabvars[var->v_catvar];
+            }
+
+}
+
+/******************************************************************************/
+/*                     IndiceTabvars_Common_Var_No_Treated                    */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvars_Common_Var_No_Treated(char *nom)
+{
+   listvar *parcours;
+   listvar *parcours2;
+
+   if ( todebug == 1 ) printf("COMMON No Treated %s \n",nom);
+
+   parcours = List_Common_Var;
+   while( parcours )
+   {
+      if ( !strcasecmp(parcours->var->v_commonname,nom) &&
+           strcasecmp(parcours->var->v_subroutinename,"") &&
+           parcours->var->v_indicetabvars == 0
+          )
+      {
+         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
+         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
+         parcours2 = parcours;
+         while ( parcours2 )
+         {
+            if ( !strcasecmp(parcours->var->v_nomvar,
+                             parcours2->var->v_nomvar) &&
+                 !strcasecmp(parcours->var->v_commonname,
+                             parcours2->var->v_commonname)
+               )
+               parcours2->var->v_indicetabvars = parcours->var->v_indicetabvars;
+            parcours2 = parcours2->suiv;
+         }
+      }
+      parcours = parcours->suiv;
+   }
+}
+
+
+/******************************************************************************/
+/*                       IndiceTabvarsIdentification                          */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void IndiceTabvarsIdentification()
+{
+   listnom *parcours_nom;
+
+   /* Identification of tabvars indices in List_Global_Var                    */
+   parcours_nom = List_NameOfModule;
+   while ( parcours_nom )
+   {
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
+      {
+         IndiceTabvars_Global_Var_Treated(parcours_nom->o_nom);
+      }
+      else
+      {
+         IndiceTabvars_Global_Var_No_Treated(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+   /* Identification of tabvars indices in List_Common_Var                    */
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
+      {
+         IndiceTabvars_Common_Var_Treated(parcours_nom->o_nom);
+      }
+      else
+      {
+         IndiceTabvars_Common_Var_No_Treated(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+
+}
+
+void New_Allocate_Subroutine_Is_Necessary()
+{
+   listnom *parcours_nom;
+   listvar *parcours;
+   int out;
+
+   parcours_nom = List_NameOfModule;
+   while ( parcours_nom )
+   {
+      /*                                                                      */
+      parcours = List_Global_Var;
+      out = 0 ;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+              !strcasecmp(parcours->var->v_subroutinename,"")            &&
+              parcours->var->v_VariableIsParameter == 0                  &&
+              ( parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type"))      &&
+              parcours->var->v_notgrid == 0                              &&
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
+         else parcours = parcours -> suiv;
+      }
+      if ( out )
+      {
+         parcours_nom->o_val = 1 ;
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+}
+
+void New_Allocate_Subroutine_For_Common_Is_Necessary()
+{
+   listnom *parcours_nom;
+   listvar *parcours;
+   int out;
+
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      parcours = List_Common_Var;
+      out = 0 ;
+      while( parcours && out == 0 )
+      {
+         if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom)  &&
+              strcasecmp(parcours->var->v_subroutinename,"")                &&
+              !strcasecmp(parcours->var->v_commoninfile,cur_filename)       &&
+              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
+              || strcasecmp(parcours->var->v_initialvalue,"") )
+            )
+         {
+            out = 1;
+         }
+         else parcours = parcours -> suiv;
+      }
+      if ( out == 1 )
+      {
+         parcours_nom->o_val = 1 ;
+      }
+      parcours_nom = parcours_nom -> suiv;
+   }
+}
+
+void NewModule_Creation_0()
+{
+   listnom *parcours_nom;
+
+   parcours_nom = List_NameOfCommon;
+   while ( parcours_nom )
+   {
+      if ( parcours_nom->o_val == 1 )
+      {
+         fprintf(fortran_out, "      module %s\n\n", parcours_nom->o_nom);
+         WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
+         fprintf(fortran_out, "        implicit none\n");
+         fprintf(fortran_out, "        public :: Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      contains\n");
+         fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "        use Agrif_Util\n");
+         fprintf(fortran_out, "        type(Agrif_grid), pointer :: Agrif_Gr\n");
+         fprintf(fortran_out, "        integer :: i\n");
+         fprintf(fortran_out, "#include \"alloc_agrif_%s.h\"\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", parcours_nom->o_nom);
+         fprintf(fortran_out, "      end module %s\n", parcours_nom->o_nom);
+         /* List all Call Alloc_agrif                                      */
+         Add_Subroutine_For_Alloc(parcours_nom->o_nom);
+      }
+      parcours_nom = parcours_nom->suiv;
+   }
+}
+
+void UpdateList_SubroutineWhereAgrifUsed()
+{
+   listnom *parcours;
+   listusemodule *parcours1;
+   listallocate *parcours2;
+   listname *parcours3;
+   listvar *parcours4;
+   int out;
+   char name_module[LONG_M];
+
+   /* We should integrate allocate and pointer variables                      */
+//    parcours2 = List_Allocate_Var;
+//    while ( parcours2 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours2 = parcours2->suiv;
+//    }
+//
+//    parcours3 = List_Pointer_Var;
+//    while ( parcours3 )
+//    {
+//       parcours4 = List_UsedInSubroutine_Var;
+//       out = 0 ;
+//       while ( parcours4 && out == 0 )
+//       {
+//          if ( !strcasecmp(parcours3->n_name, parcours4->var->v_nomvar) )
+//          {
+//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//             out = 1;
+//          }
+//          else parcours4 = parcours4 -> suiv ;
+//       }
+//       parcours3 = parcours3 -> suiv;
+//    }
+//    parcours4 = List_UsedInSubroutine_Var;
+//    while ( parcours4 )
+//    {
+//       if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
+//       {
+//          Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
+//       }
+//       parcours4 = parcours4 -> suiv ;
+//    }
+
+   parcours = List_SubroutineWhereAgrifUsed;
+   while ( parcours )
+   {
+      parcours1 = List_NameOfModuleUsed;
+      out = 0 ;
+      strcpy(name_module,"");
+      while ( parcours1 && out == 0 )
+      {
+         if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) &&
+              !strcasecmp(parcours1->u_usemodule,"Agrif_Util")
+            ) out = 1;
+         else
+         {
+            if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) )
+            {
+               strcpy(name_module, parcours->o_module);
+            }
+            parcours1 = parcours1->suiv;
+         }
+      }
+      if ( out == 0 )   /* we should look in the module declaration */
+      {
+         parcours1 = List_NameOfModuleUsed;
+         out = 0 ;
+         while ( parcours1 && out == 0 )
+         {
+            if ( !strcasecmp(name_module,parcours1->u_modulename) &&
+                 !strcasecmp(parcours1->u_cursubroutine,"")&&
+                 !strcasecmp(parcours1->u_usemodule,"Agrif_Util")
+               ) out = 1;
+            else parcours1 = parcours1->suiv;
+         }
+      }
+      if ( out == 0 ) parcours->o_val = 1;
+
+      parcours = parcours->suiv;
+   }
+}
+
+
+void UpdateList_UsedInSubroutine_With_dimension()
+{
+   listvar *parcours;
+
+   parcours = List_UsedInSubroutine_Var;
+   while ( parcours )
+   {
+      if ( parcours->var->v_nbdim != 0 )
+      {
+         strcpy(subroutinename,parcours->var->v_subroutinename);
+         DecomposeTheName(parcours->var->v_readedlistdimension);
+         strcpy(subroutinename,"");
+      }
+      parcours = parcours -> suiv;
+   }
+}
+
+void Affiche(listvar *in_parcours)
+{
+/*   parcours = List_Global_Var;                  */
+/*   parcours = List_SubroutineDeclaration_Var;   */
+/*   parcours = List_SubroutineArgument_Var;      */
+/*   parcours = List_FunctionType_Var;            */
+/*   parcours = List_Data_Var;                    */
+/*   parcours = List_Save_Var;                    */
+/*   parcours = List_UsedInSubroutine_Var;        */
+/*   parcours = List_Parameter_Var;               */
+/*   parcours = List_GlobalParameter_Var;         */
+/*   parcours = List_NotGridDepend_Var;           */
+/*   parcours = List_Common_Var;                  */
+   listvar *parcours = in_parcours;
+
+   while( parcours )
+   {
+      printf("modulename     - %s \n", parcours->var->v_modulename);
+      printf("subroutinename - %s \n", parcours->var->v_subroutinename);
+      printf("nomvar         - %s \n", parcours->var->v_nomvar);
+      printf("commonname     - %s \n", parcours->var->v_commonname);
+      printf("commoninfile   - %s \n", parcours->var->v_commoninfile);
+      printf("typevar        - %s \n", parcours->var->v_typevar);
+      printf("catvar         - %d \n", parcours->var->v_catvar);
+      printf("indicetabvars  - %d \n", parcours->var->v_indicetabvars);
+      printf("isparameter    - %d \n", parcours->var->v_VariableIsParameter);
+      printf("module         - %d \n", parcours->var->v_module);
+      printf("save           - %d \n", parcours->var->v_save);
+      printf("notgrid        - %d \n", parcours->var->v_notgrid);
+      printf("nbdim          - %d \n", parcours->var->v_nbdim);
+      printf("common         - %d \n", parcours->var->v_common);
+      printf("dimensiongiven - %d \n", parcours->var->v_dimensiongiven);
+      printf("dimsempty      - %d \n", parcours->var->v_dimsempty);
+      printf("initialvalue   - %s \n", parcours->var->v_initialvalue);
+      printf("readedlistdim  - %s \n", parcours->var->v_readedlistdimension);
+      printf("-------------------------------------\n");
+
+      parcours = parcours -> suiv ;
+   }
+   if ( todebug == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars[0]);
+}
+
+int SubInList_ContainsSubroutine()
+{
+   int out;
+   listnom *parcours;
+
+   out = 0 ;
+   parcours = List_ContainsSubroutine;
+   while ( parcours && out == 0 )
+   {
+      if ( !strcasecmp(parcours->o_nom,subroutinename) ) out = 1 ;
+      else parcours = parcours -> suiv;
+   }
+
+   return out;
+}
Index: vendors/AGRIF/LIB/WorkWithvarofsubroutineliste.c
===================================================================
--- vendors/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 9621)
+++ vendors/AGRIF/LIB/WorkWithvarofsubroutineliste.c	(revision 9621)
@@ -0,0 +1,78 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                      Add_SubroutineArgument_Var_1                          */
+/******************************************************************************/
+void Add_SubroutineArgument_Var_1(listvar *listtoadd)
+{
+    List_SubroutineArgument_Var = AddListvarToListvar(listtoadd, List_SubroutineArgument_Var, 1);
+}
+
+/******************************************************************************/
+/*                             Add_FunctionType_Var_1                         */
+/******************************************************************************/
+void Add_FunctionType_Var_1(const char *nom)
+{
+    listvar *newvar;
+
+    curvar = createvar(nom, NULL);
+    strcpy(curvar->v_typevar, DeclType);
+    newvar = insertvar(NULL, curvar);
+    List_FunctionType_Var = AddListvarToListvar(newvar,List_FunctionType_Var,1);
+}
+
+/******************************************************************************/
+/*                      Add_SubroutineDeclaration_Var_1                       */
+/******************************************************************************/
+/* We should complete the listvarofsubroutine                                 */
+/******************************************************************************/
+// void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd)
+// {
+//    if ( firstpass == 1 )
+//    {
+//       if ( VariableIsParameter == 0 &&
+//            SaveDeclare         == 0 )
+//       {
+//          listduplicated = (listvar *)NULL;
+//          duplicatelistvar(listtoadd);
+//          List_SubroutineDeclaration_Var = AddListvarToListvar(listduplicated,List_SubroutineDeclaration_Var,1);
+//       }
+//    }
+// }
Index: vendors/AGRIF/LIB/WriteInFile.c
===================================================================
--- vendors/AGRIF/LIB/WriteInFile.c	(revision 9621)
+++ vendors/AGRIF/LIB/WriteInFile.c	(revision 9621)
@@ -0,0 +1,159 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+/******************************************************************************/
+/*                            tofich_reste                                    */
+/******************************************************************************/
+/* This subroutine is used to write the string s into the fileout             */
+/******************************************************************************/
+void tofich_reste (FILE * filout, const char *s, int do_returnline)
+{
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
+
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
+    {
+        if ( do_returnline ) fprintf(filout, "     &%s\n", s);
+        else                 fprintf(filout, "&%s", s);
+    }
+    else
+    {
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
+        if ( retour77 == 0 && (s_length-strlen(temp) > 0) )
+                fprintf(filout, "     &%s&\n", temp);
+        else    fprintf(filout, "     &%s\n", temp);
+
+        if ( s_length-strlen(temp) > 0 )
+            tofich_reste(filout, (char *) &s[line_length], do_returnline);
+    }
+}
+
+/******************************************************************************/
+/*                            tofich                                          */
+/******************************************************************************/
+/* This subroutine is used to write the string s into the fileout             */
+/******************************************************************************/
+void tofich (FILE * filout, const char *s, int do_returnline)
+{
+    const size_t line_length = 66;
+    char temp[line_length+1];
+    size_t s_length;
+
+    s_length = strlen(s);
+
+    if ( !strcmp(&s[strlen(s)-1], "\n") )
+        s_length = strlen(s)-1;
+
+    if ( s_length <= line_length )
+    {
+        if ( do_returnline ) fprintf(filout, "      %s\n", s);
+        else                 fprintf(filout, "%s", s);
+    }
+    else
+    {
+        strncpy(temp, s, line_length);
+        temp[line_length] = '\0';
+
+        if ( retour77 == 0 )    fprintf(filout, "      %s&\n", temp);
+        else                    fprintf(filout, "      %s\n", temp);
+
+        tofich_reste(filout, (char *) &s[line_length], do_returnline);
+    }
+}
+
+/******************************************************************************/
+/*                       tofich_blanc                                         */
+/******************************************************************************/
+/* This subroutine is used to write size blank into the fileout               */
+/******************************************************************************/
+void tofich_blanc (FILE * filout, int size)
+{
+    const char* empty_char = " ";
+    int i = 0;
+
+    if (size <= 65)
+        fprintf(filout, "%*s\n", size, empty_char);
+    else
+    {
+        do
+        {
+            fprintf(filout, "%*s\n", 65, empty_char);
+            i++;
+        }
+        while ( i <= size / 65 );
+
+        fprintf(filout, "%*s\n", size%65, empty_char);
+    }
+}
+
+/******************************************************************************/
+/*                           RemoveWordSET_0                                  */
+/******************************************************************************/
+/* This subroutine is used to remove a sentence in the file filout            */
+/******************************************************************************/
+void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove)
+{
+    if ( inside_type_declare || firstpass ) return;
+
+    fseek(filout, position, SEEK_SET);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, position, SEEK_SET);
+}
+
+/******************************************************************************/
+/*                         RemoveWordCUR_0                                    */
+/******************************************************************************/
+/* This subroutine is used to remove a sentence in the file filout            */
+/******************************************************************************/
+void RemoveWordCUR_0(FILE * filout, int sizetoremove)
+{
+    if ( inside_type_declare || firstpass ) return;
+
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    tofich_blanc(filout, sizetoremove);
+    fseek(filout, (long int)(-sizetoremove), SEEK_CUR);
+    if ( strstr(fortran_text, "\n") )   fprintf(filout, "\n");
+}
Index: vendors/AGRIF/LIB/Writedeclarations.c
===================================================================
--- vendors/AGRIF/LIB/Writedeclarations.c	(revision 9621)
+++ vendors/AGRIF/LIB/Writedeclarations.c	(revision 9621)
@@ -0,0 +1,668 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "decl.h"
+
+/******************************************************************************/
+/*                         WriteBeginDeclaration                              */
+/******************************************************************************/
+/* This subroutine is used to write the begin of a declaration                */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*       integer variable ----------->   INTEGER                              */
+/*                                                                            */
+/******************************************************************************/
+void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility)
+{
+  char tmpligne[LONG_M];
+  int precision_given ;
+
+  if ( !strcasecmp(v->v_typevar,"") )
+  {
+     printf("# WARNING : The type of the variable %s is unknown.\n", v->v_nomvar);
+     printf("#           CONV should define a type\n");
+  }
+
+  sprintf(line, "%s", v->v_typevar);
+  if ( v->v_c_star == 1 ) strcat(line, "*");
+
+  /* We should give the precision of the variable if it has been given        */
+  precision_given = 0;
+  if ( strcasecmp(v->v_precision,"") )
+  {
+     sprintf(tmpligne, "(%s)", v->v_precision);
+     Save_Length(tmpligne, 49);
+     strcat(line, tmpligne);
+     precision_given = 1;
+  }
+
+  if (strcasecmp(v->v_dimchar,""))
+  {
+     sprintf(tmpligne,"(%s)",v->v_dimchar);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+
+  if ((precision_given == 0) && ( strcasecmp(v->v_nameinttypename,"") ))
+  {
+     sprintf(tmpligne,"*%s",v->v_nameinttypename);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+  if (strcasecmp (v->v_IntentSpec, ""))
+  {
+     sprintf(tmpligne,", intent(%s)", v->v_IntentSpec);
+     Save_Length(tmpligne, 49);
+     strcat(line,tmpligne);
+  }
+  if ( v->v_VariableIsParameter ) strcat(line, ", parameter");
+  if ( visibility )
+  {
+      if ( v->v_PublicDeclare  )  strcat(line, ", public");
+      if ( v->v_PrivateDeclare )  strcat(line, ", private");
+  }
+  if ( v->v_ExternalDeclare ) strcat(line, ", external");
+  if ( v->v_allocatable     ) strcat(line, ", allocatable");
+  if ( v->v_target          ) strcat(line, ", target");
+  if ( v->v_optionaldeclare ) strcat(line, ", optional");
+  if ( v->v_pointerdeclare  ) strcat(line, ", pointer");
+  Save_Length(line, 45);
+}
+
+
+/******************************************************************************/
+/*                         WriteScalarDeclaration                             */
+/******************************************************************************/
+/* This subroutine is used to write a scalar declaration                      */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*       integer variable ----------->   INTEGER :: VARIABLE                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteScalarDeclaration( variable *v, char line[LONG_M])
+{
+    strcat(line, " :: ");
+    strcat(line, v->v_nomvar);
+
+    if ( strcasecmp(v->v_vallengspec, "") ) strcat(line,v->v_vallengspec);
+    if ( v->v_VariableIsParameter )
+    {
+        strcat(line," = ");
+        strcat(line, v->v_initialvalue);
+    }
+    Save_Length(line, 45);
+}
+
+/******************************************************************************/
+/*                         WriteTableDeclaration                              */
+/******************************************************************************/
+/* This subroutine is used to write a Table declaration                       */
+/* taken in a variable record                                                 */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                      INTEGER, DIMENSION(1:nb) :: variable                  */
+/*                                                                            */
+/******************************************************************************/
+void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok)
+{
+    char newname[LONG_M];
+
+    strcat (ligne, ", dimension(");
+
+    if ( v->v_dimensiongiven == 1 && tmpok == 1 )   strcat(ligne,v->v_readedlistdimension);
+    if ( v->v_dimensiongiven == 1 && tmpok == 0 )
+    {
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(v->v_readedlistdimension,List_Global_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension);
+
+        Save_Length(newname,47);
+        strcat(ligne,newname);
+    }
+    strcat(ligne, ") :: ");
+    strcat(ligne, v->v_nomvar);
+    if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec);
+
+    if ( v->v_VariableIsParameter == 1 )
+    {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+    }
+    Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                        WriteVarDeclaration                                 */
+/******************************************************************************/
+/* This subroutine is used to write the initial declaration in the file       */
+/* fileout of a variable                                                      */
+/*                                                                            */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                      INTEGER, DIMENSION(1:nb),Pointer :: variable          */
+/*                                                                            */
+/******************************************************************************/
+void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility )
+{
+  FILE *filecommon;
+  char ligne[LONG_M];
+
+  filecommon = fileout;
+
+  if ( v->v_save == 0 || inmodulemeet == 0 )
+  {
+     WriteBeginDeclaration(v, ligne, visibility);
+
+     if ( v->v_nbdim == 0 )
+        WriteScalarDeclaration(v, ligne);
+     else
+        WriteTableDeclaration(v, ligne, value);
+
+     if ( v->v_VariableIsParameter != 1 && strcasecmp(v->v_initialvalue,"") )
+     {
+        strcat(ligne," = ");
+        strcat(ligne,v->v_initialvalue);
+     }
+     tofich(filecommon, ligne, 1);
+  }
+  else
+    printf("-- in writevardeclaration : |%s| -- MHCHECK\n", v->v_nomvar);
+  Save_Length(ligne,45);
+}
+
+
+void WriteLocalParamDeclaration(FILE* tofile)
+{
+    listvar *parcours;
+
+    parcours = List_Parameter_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 0, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteFunctionDeclaration(FILE* tofile, int value)
+{
+    listvar *parcours;
+
+    parcours = List_FunctionType_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+              strcasecmp(parcours->var->v_typevar, "") )
+        {
+            WriteVarDeclaration(parcours->var, tofile, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteSubroutineDeclaration(int value)
+{
+    listvar *parcours;
+    variable *v;
+
+    parcours = List_SubroutineDeclaration_Var;
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename)   &&
+             (v->v_save == 0)                                   &&
+             (v->v_pointerdeclare == 0)                         &&
+             (v->v_VariableIsParameter == 0)                    &&
+             (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        else if ( !strcasecmp(v->v_subroutinename, subroutinename)  &&
+                  (v->v_save == 0)                                  &&
+                  (v->v_VariableIsParameter == 0)                   &&
+                  (v->v_common == 0) )
+        {
+            WriteVarDeclaration(v, fortran_out, value, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+void WriteArgumentDeclaration_beforecall()
+{
+    int position;
+    listnom *neededparameter;
+    FILE *paramtoamr;
+    listvar *parcours;
+    variable *v;
+    char ligne[LONG_M];
+
+    fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename);
+
+    sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename);
+    paramtoamr = open_for_write(ligne);
+
+    neededparameter = (listnom * )NULL;
+    position = 1;
+    parcours = List_SubroutineArgument_Var;
+
+    while ( parcours )
+    {
+        v = parcours->var;
+        if ( !strcasecmp(v->v_subroutinename, subroutinename) && (v->v_positioninblock == position) )
+        {
+            position++;
+            WriteVarDeclaration(v, fortran_out, 0, 1);
+            neededparameter = writedeclarationintoamr(List_Parameter_Var, paramtoamr,
+                                    v, v->v_subroutinename, neededparameter, subroutinename);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+    Save_Length(ligne,45);
+
+    // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module
+    if ( IsTabvarsUseInArgument_0() && (inmodulemeet == 0) && (inprogramdeclare == 0) )
+    {
+        fprintf(paramtoamr, "      interface\n");
+        if (isrecursive) sprintf(ligne,"  recursive subroutine Sub_Loop_%s(", subroutinename);
+        else             sprintf(ligne,"  subroutine Sub_Loop_%s(", subroutinename);
+        WriteVariablelist_subloop(ligne);
+        WriteVariablelist_subloop_Def(ligne);
+        strcat(ligne,")");
+        Save_Length(ligne,45);
+        tofich(paramtoamr,ligne,1);
+
+        listusemodule *parcours_mod;
+        parcours_mod = List_NameOfModuleUsed;
+        while ( parcours_mod )
+        {
+            if ( !strcasecmp(parcours_mod->u_cursubroutine, subroutinename) )
+            {
+                fprintf(paramtoamr, "          use %s\n", parcours_mod->u_usemodule);
+            }
+            parcours_mod = parcours_mod->suiv;
+        }
+        fprintf(paramtoamr, "          implicit none\n");
+        WriteLocalParamDeclaration(paramtoamr);
+        writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var, paramtoamr);
+        writesub_loopdeclaration_tab(List_UsedInSubroutine_Var, paramtoamr);
+        WriteArgumentDeclaration_Sort(paramtoamr);
+        WriteFunctionDeclaration(paramtoamr, 1);
+
+        sprintf(ligne,"  end subroutine Sub_Loop_%s\n", subroutinename);
+        tofich(paramtoamr, ligne, 1);
+        fprintf(paramtoamr, "      end interface\n");
+    }
+    fclose(paramtoamr);
+}
+
+void WriteArgumentDeclaration_Sort(FILE* tofile)
+{
+    int position = 1;
+    listvar *parcours;
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) &&
+                         parcours->var->v_positioninblock == position )
+        {
+            position = position + 1;
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+            parcours = List_SubroutineArgument_Var;
+        }
+        else parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                        parcours->var->v_nbdim == 0 )
+        {
+            WriteVarDeclaration(parcours->var,tofile,1,1);
+        }
+        parcours = parcours -> suiv;
+    }
+
+    parcours = List_SubroutineArgument_Var;
+    while ( parcours )
+    {
+        if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) &&
+                         parcours->var->v_positioninblock == 0           &&
+                         parcours->var->v_nbdim != 0 )
+        {
+            WriteVarDeclaration(parcours->var, tofile, 1, 1);
+        }
+        parcours = parcours -> suiv;
+    }
+}
+
+/******************************************************************************/
+/*                      writedeclarationintoamr                               */
+/******************************************************************************/
+/* This subroutine is used to write the declaration of parameters needed in   */
+/*    allocation subroutines creates in toamr.c                               */
+/******************************************************************************/
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+listnom *writedeclarationintoamr (listvar * deb_common, FILE *fileout,
+                              variable *var , const char *commonname,
+                           listnom *neededparameter, const char *name_common)
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_M];
+  int changeval;
+  int out;
+  int writeit;
+  listnom *parcours;
+
+  /* we should list the needed parameter                                      */
+  if ( !strcasecmp(name_common,commonname) )
+     neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,neededparameter);
+  /*                                                                          */
+  parcours = neededparameter;
+  while (parcours)
+  {
+     newvar = deb_common;
+
+     out = 0 ;
+     while ( newvar && out == 0 )
+     {
+
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
+        {
+           out=1;
+        /* add the name to the list of needed parameter                       */
+           neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue,
+                 neededparameter );
+        }
+        else newvar=newvar->suiv;
+     }
+     parcours=parcours->suiv;
+   }
+  /*                                                                          */
+  parcours = neededparameter;
+  while (parcours)
+  {
+     newvar = deb_common;
+     out = 0 ;
+     while ( newvar && out == 0 )
+     {
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename))
+        {
+           out=1;
+        /* add the name to the list of needed parameter                       */
+           neededparameter = DecomposeTheNameinlistnom(
+                 newvar->var->v_initialvalue,
+                 neededparameter );
+        }
+        else newvar=newvar->suiv;
+     }
+     parcours=parcours->suiv;
+   }
+  parcours = neededparameter;
+  while (parcours)
+  {
+     writeit = 0;
+     newvar = deb_common;
+     while ( newvar && writeit == 0 )
+     {
+        if ( !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) &&
+            !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename) && parcours->o_val == 0 )
+        {
+           writeit=1;
+           parcours->o_val = 1;
+        }
+        else newvar = newvar->suiv;
+     }
+
+     if ( writeit == 1  )
+     {
+        changeval = 0;
+        v = newvar->var;
+//        if ( v->v_allocatable == 1 && strcasecmp(v->v_typevar,"type") )
+//        {
+//           changeval = 1;
+//           v->v_allocatable = 0;
+//        }
+        WriteBeginDeclaration(v, ligne, 1);
+        if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne);
+        else WriteTableDeclaration(v, ligne, 1);
+
+        tofich(fileout, ligne, 1);
+        if ( changeval == 1 )
+        {
+           v->v_allocatable = 1;
+        }
+     }
+     else
+     {
+        if (  strncasecmp(parcours->o_nom,"mpi_",4) == 0 &&
+              shouldincludempif                     == 1 )
+        {
+           shouldincludempif = 0;
+           fprintf(fileout,"      include \'mpif.h\'\n");
+        }
+     }
+     parcours=parcours->suiv;
+  }
+  Save_Length(ligne,45);
+  return neededparameter;
+}
+
+
+/******************************************************************************/
+/*                       writesub_loopdeclaration_scalar                      */
+/******************************************************************************/
+/* This subroutine is used to write the declaration part of subloop           */
+/*    subroutines                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                                                                            */
+/*          INTEGER, DIMENSION(1:nb)         :: variable                      */
+/*                                                                            */
+/******************************************************************************/
+void writesub_loopdeclaration_scalar (listvar * deb_common, FILE *fileout)
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_M];
+
+//   tofich (fileout, "",1);
+  newvar = deb_common;
+
+  while (newvar)
+  {
+     if ( newvar->var->v_nbdim == 0 &&
+          !strcasecmp(newvar->var->v_subroutinename,subroutinename)  &&
+           (newvar->var->v_pointerdeclare == 0 || !strcasecmp(newvar->var->v_typevar,"type")) )
+     {
+        v = newvar->var;
+
+        WriteBeginDeclaration(v,ligne,1);
+        WriteScalarDeclaration(v,ligne);
+        tofich (fileout, ligne,1);
+     }
+     newvar = newvar->suiv;
+  }
+  Save_Length(ligne,45);
+}
+
+/******************************************************************************/
+/*                       writesub_loopdeclaration_tab                         */
+/******************************************************************************/
+/* This subroutine is used to write the declaration part of subloop           */
+/*    subroutines                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  integer variable(nb) ----------->                                         */
+/*                                                                            */
+/*          INTEGER, DIMENSION(1:nb)         :: variable                      */
+/*                                                                            */
+/******************************************************************************/
+void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout)
+{
+  listvar *newvar;
+  variable *v;
+  char ligne[LONG_M];
+  int changeval;
+
+  newvar = deb_common;
+  while (newvar)
+  {
+      v = newvar->var;
+//  printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar);
+     if ( (v->v_nbdim != 0)  && !strcasecmp(v->v_subroutinename, subroutinename) &&
+          (v->v_pointerdeclare == 0 || !strcasecmp(v->v_typevar,"type")) )
+     {
+        changeval = 0;
+        if ( v->v_allocatable == 1)
+        {
+          if (strcasecmp(v->v_typevar,"type"))
+           {
+      //     changeval = 1;
+      //     v->v_allocatable = 0;
+           }
+          else
+           {
+           changeval = 2;
+           v->v_allocatable = 0;
+           v->v_pointerdeclare = 1;
+           }
+        }
+
+        WriteBeginDeclaration(v, ligne, 1);
+        WriteTableDeclaration(v, ligne, 1);
+        tofich (fileout, ligne,1);
+        if ( changeval >= 1 ) v->v_allocatable = 1;
+        if ( changeval == 2 ) v->v_pointerdeclare = 0;
+     }
+     newvar = newvar->suiv;
+  }
+  Save_Length(ligne,45);
+}
+
+void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl)
+{
+    listvar *parcours;
+    variable *v;
+    int out;
+
+    if ( insubroutinedeclare )
+    {
+        parcours = listdecl;
+        while ( parcours )
+        {
+            v = parcours->var;
+                          out = LookingForVariableInList(List_SubroutineArgument_Var, v);
+            if (out == 0) out = VariableIsInListCommon(parcours, List_Common_Var);
+            if (out == 0) out = LookingForVariableInList(List_Parameter_Var, v);
+            if (out == 0) out = LookingForVariableInList(List_FunctionType_Var, v);
+            if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var, v);
+
+            if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0)
+            {
+                WriteVarDeclaration(v, fortran_out, 1, 1);
+            }
+            if (firstpass == 1)
+            {
+                if (VariableIsParameter == 0 && SaveDeclare == 0)
+                {
+                    List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var, v);
+                }
+            }
+            parcours = parcours->suiv;
+        }
+    }
+}
+
+void ReWriteDataStatement_0(FILE * filout)
+{
+    listvar *parcours;
+    int out;
+    char ligne[LONG_M];
+    char initialvalue[LONG_M];
+
+    if (insubroutinedeclare == 1)
+    {
+        parcours = List_Data_Var_Cur ;
+        while (parcours)
+        {
+            out = VariableIsInListCommon(parcours,List_Common_Var);
+            if (out)   break;
+
+            out = LookingForVariableInListGlobal(List_Global_Var,parcours->var);
+            if (out)   break;
+
+            if (strncasecmp(parcours->var->v_initialvalue,"(/",2))
+            {
+                strcpy(initialvalue,parcours->var->v_initialvalue);
+            }
+            else
+            {
+                strncpy(initialvalue,&parcours->var->v_initialvalue[2],strlen(parcours->var->v_initialvalue)-4);
+                strcpy(&initialvalue[strlen(parcours->var->v_initialvalue)-4],"\0");
+            }
+            sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue);
+            tofich(filout,ligne,1);
+
+            parcours = parcours->suiv;
+        }
+    }
+}
Index: vendors/AGRIF/LIB/decl.h
===================================================================
--- vendors/AGRIF/LIB/decl.h	(revision 9621)
+++ vendors/AGRIF/LIB/decl.h	(revision 9621)
@@ -0,0 +1,662 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#define LONG_VNAME 80		// Max length for a variable name
+#define LONG_FNAME 1000		// Max length for a file name
+#define LONG_C     200
+#define LONG_M     2000
+
+#define NB_CAT_VARIABLES 5
+
+/******************************************************************************/
+/*********** Declaration of structures used in conv ***************************/
+/******************************************************************************/
+
+typedef struct
+{
+   char first[LONG_M];
+   char last[LONG_M];
+} typedim ;                /* fortran dimension as 'ndeb:nfin'                */
+
+typedef struct listdim
+{
+   typedim dim;
+   struct listdim *suiv;
+} listdim;                 /* list of the dimensions of a variable            */
+
+typedef struct variable
+{
+   char v_typevar[LONG_VNAME];
+   char v_nomvar[LONG_VNAME] ;
+   char v_oldname[LONG_VNAME] ;
+   char v_dimchar[LONG_VNAME];
+   char v_modulename[LONG_VNAME];
+   char v_commonname[LONG_VNAME];
+   char v_vallengspec[LONG_VNAME];
+   char v_nameinttypename[LONG_VNAME];
+   char v_commoninfile[LONG_FNAME];
+   char v_subroutinename[LONG_VNAME];
+   char v_precision[LONG_C];
+   char v_initialvalue[LONG_M];
+   char v_IntentSpec[LONG_M];
+   char v_readedlistdimension[LONG_M];
+   int  v_nbdim;
+   int  v_common;
+   int  v_positioninblock;
+   int  v_module;
+   int  v_save;
+   int  v_catvar;
+   int  v_VariableIsParameter;
+   int  v_PublicDeclare;
+   int  v_PrivateDeclare;
+   int  v_ExternalDeclare;
+   int  v_pointedvar;
+   int  v_notgrid;
+   int  v_dimensiongiven;
+   int  v_c_star;
+   int  v_indicetabvars;
+   int  v_pointerdeclare;
+   int  v_optionaldeclare;
+   int  v_allocatable;
+   int  v_target;
+   int  v_dimsempty;
+   listdim *v_dimension;
+} variable ;               /* type of a variable                              */
+                           /* v_typevar : type (integer, real, ...)           */
+                           /* v_nomvar : name of the variable                 */
+                           /* v_dimension : list of dimensions of the variable*/
+                           /* v_nbdim: 1 if the variable is 1d, etc ...       */
+                           /* precision : Name of the variable which          */
+                           /* determine the precision. example : wp in the    */
+                           /* case where REAL(wp)                             */
+
+typedef struct listvar
+{
+   variable *var ;
+   struct listvar * suiv;
+} listvar ;                /* list of variables                               */
+
+
+typedef struct listusemodule
+{
+   char u_usemodule[LONG_VNAME];
+   char u_charusemodule[LONG_VNAME];
+   char u_cursubroutine[LONG_VNAME];
+   char u_modulename[LONG_VNAME];
+   int  u_firstuse;
+   struct listusemodule * suiv;
+} listusemodule;           /* list of names                                   */
+
+typedef struct listparameter
+{
+   char p_name[LONG_M];
+   char p_modulename[LONG_M];
+   struct listparameter * suiv;
+} listparameter ;           /* list of names                                  */
+
+typedef struct listname
+{
+   char n_name[LONG_VNAME];
+   struct  listname* suiv;
+} listname ;            /* list of names                                  */
+
+typedef struct listcouple
+{
+   char c_namevar[LONG_VNAME];
+   char c_namepointedvar[LONG_VNAME];
+   struct listcouple * suiv;
+} listcouple;              /* list of names                                   */
+
+
+typedef struct listnom
+{
+   char o_nom[LONG_C];
+   char o_module[LONG_VNAME];
+   char o_subroutinename[LONG_M];
+   int  o_val;
+   listcouple *couple;
+   struct listnom * suiv;
+} listnom;                 /* list of names                                   */
+
+
+typedef struct listallocate
+{
+   char a_nomvar[LONG_C];
+   char a_subroutine[LONG_VNAME];
+   char a_module[LONG_VNAME];
+   struct listallocate * suiv;
+} listallocate ;
+
+
+typedef struct listvarpointtovar
+{
+   char t_usemodule[LONG_VNAME];
+   char t_cursubroutine[LONG_VNAME];
+   listcouple *t_couple;
+   struct  listvarpointtovar* suiv;
+}listvarpointtovar ;       /* list of names                                   */
+
+
+typedef struct listindice
+{
+   int i_indice;
+   struct  listindice * suiv;
+} listindice;              /* list of indiced                                 */
+
+ variable *curvar;
+
+ listvar *List_ModuleUsedInModuleUsed_Var;
+ listvar *List_ModuleUsed_Var;
+ listvar *listduplicated;
+
+ listvar *List_GlobalParameter_Var;
+ listvar *List_Global_Var;
+ listvar *List_Data_Var;
+ listvar *List_Data_Var_Cur;
+ listvar *List_Save_Var;
+ listvar *List_SubroutineArgument_Var;
+ listvar *List_SubroutineDeclaration_Var;
+ listvar *List_UsedInSubroutine_Var;
+ listvar *List_Parameter_Var;
+ listvar *List_Dimension_Var;
+ listvar *List_FunctionType_Var;
+ listvar *List_NotGridDepend_Var;
+ listvar *List_Common_Var;
+
+
+ listname *List_Pointer_Var;
+ listname *List_ImplicitNoneSubroutine;
+
+ listusemodule *List_NameOfModuleUsed;
+ listusemodule *List_Include;
+ listusemodule *listofmoduletmp;
+ listusemodule *tmpuselocallist;
+
+ listparameter *List_GlobParamModuleUsedInModuleUsed_Var;
+ listparameter *List_GlobParamModuleUsed_Var;
+
+ listnom *List_ContainsSubroutine;
+ listnom *List_Subroutine_For_Alloc;
+ listnom *listofmodules;
+ listnom *listofkind;
+ listnom *List_NameOfModule;
+ listnom *List_NameOfCommon;
+ listnom *List_SubroutineWhereAgrifUsed;
+
+ listallocate *List_Allocate_Var;
+
+ listvarpointtovar *List_CouplePointed_Var;
+                           /*  variables which are pointed to an other one    */
+
+ listindice *Listofavailableindices;
+                           /* List of available indices in the tabvars table  */
+ listindice **Listofavailableindices_glob;
+
+ listdim *curdim;
+ listdim *commondim;
+
+/******************************************************************************/
+/****************   *** COMMON Variables ***  *********************************/
+/******************************************************************************/
+
+ int positioninblock;
+ char commonvar[LONG_VNAME];
+ char commonblockname[LONG_VNAME];
+
+/******************************************************************************/
+/****************   *** AGRIF Variables ***   *********************************/
+/******************************************************************************/
+ int inagrifcallargument;
+ int afterpercent;
+ int sameagrifargument;
+ int InAgrifParentDef;
+ char sameagrifname[LONG_VNAME];
+/******************************************************************************/
+/****************   *** VAR DEF Variables ***   *******************************/
+/******************************************************************************/
+ int indicemaxtabvars[NB_CAT_VARIABLES];     /* Number of variables in the model i.e. last      */
+                           /*    indice used in  the tabvars table            */
+ int PublicDeclare;        /* Variable has been declared as PUBLIC */
+ int PrivateDeclare;       /* Variable has been declared as PRIVATE */
+ int ExternalDeclare;      /* Variable has been declared as EXTERNAL */
+ int InitialValueGiven;    /* An initial value has been given */
+ int Allocatabledeclare;
+ int Targetdeclare;
+ int SaveDeclare;
+ int functiondeclarationisdone;
+ int pointerdeclare;
+ int optionaldeclare;
+ int inside_type_declare;
+ int VariableIsParameter;
+ int dimsgiven;
+ int shouldincludempif;
+ int c_star;
+ char DeclType[LONG_VNAME];
+ char nameinttypename[LONG_VNAME];
+ char nameinttypenameback[LONG_VNAME];
+ int GlobalDeclaration;
+ int GlobalDeclarationType;
+ char InitValue[LONG_M];
+ char IntentSpec[LONG_M];
+ char NamePrecision[LONG_C];
+ char CharacterSize[LONG_VNAME];
+ char vallengspec[LONG_VNAME];
+ int isrecursive;
+ int is_result_present;
+
+/******************************************************************************/
+/****************   *** CONV Variables ***   **********************************/
+/******************************************************************************/
+ int dimprob ;             /* dimension of the problem : 1 for 1D,2 for 2D,   */
+                           /*    3 for 3D                                     */
+ int onlyfixedgrids;       /* = 1 if onlyfixedgrids is true                   */
+ int todebug;
+ int fixedgrids;           /* = 1 if fixedgrids is true                       */
+ char nbmaillesX[LONG_VNAME];	// number of cells in the x direction
+ char nbmaillesY[LONG_VNAME];	// number of cells in the y direction
+ char nbmaillesZ[LONG_VNAME];	// number of cells in the z direction
+ int IndicenbmaillesX;
+ int IndicenbmaillesY;
+ int IndicenbmaillesZ;
+
+ int inmodulemeet;
+ int incalldeclare;
+ int aftercontainsdeclare; /* Signale si l'on vient d'un contains ou non */
+ int retour77;
+ int callagrifinitgrids;
+ int callmpiinit;
+ int firstpass;
+ int pointedvar;
+ int NbMailleXDefined;
+ int agrif_parentcall;
+ int didvariableadded;
+ int SubloopScalar;        /* = 1 we should put in argument of sub_loop       */
+                           /*    only                                         */
+                           /*    scalar and not table u(1,1,1) in place of u  */
+ int inprogramdeclare;
+ int insubroutinedeclare;
+ int inmoduledeclare;
+ int dimsempty;
+ int created_dimensionlist;
+ int incontainssubroutine;
+
+ char meetagrifinitgrids[LONG_M];
+ char mpiinitvar[LONG_M];
+ char toprintglob[LONG_M];
+ char tmpvargridname[LONG_M];
+ char dependfilename[LONG_FNAME];
+ char charusemodule[LONG_VNAME];
+ char subofagrifinitgrids[LONG_M];
+ char curmodulename[LONG_VNAME];
+ char subroutinename[LONG_VNAME];
+ char cur_filename[LONG_FNAME];		// Name of the current parsed Fortran file
+ char config_file[LONG_FNAME];		// Name of conv configuration file (ex: amr.in)
+ char work_dir[LONG_FNAME];			// Work directory         (default: './')
+ char include_dir[LONG_FNAME];		// Include directory      (default: './AGRIF_INC')
+ char output_dir[LONG_FNAME];		// output directory       (default: './AGRIF_MODELFILES')
+ char input_dir[LONG_FNAME];		// source input directory (default: './')
+
+ FILE *fortran_out;          /* Output File                                    */
+ FILE *fortran_in;           /* Input File                                     */
+ FILE *oldfortran_out;
+ FILE *subloop;
+ FILE *module_declar;
+ FILE *allocationagrif;
+
+ long int pos_cur;         /* current position in the output file             */
+ long int pos_curagrifparent;
+                           /* current position in the output file             */
+ long int pos_curcall;     /* current position in the output file             */
+ long int pos_curuse;      /* current position in the output file             */
+ long int pos_curuseold;   /* current position in the output file             */
+ long int pos_curfunction; /* current position in the output file             */
+ long int pos_cur_decl;    /* current position in the output file             */
+ long int pos_curdata;     /* current position in the output file             */
+ long int pos_curparameter;/* current position in the output file             */
+ long int pos_curcommon;   /* current position in the output file             */
+ long int pos_cursave;     /* current position in the output file             */
+ long int pos_curdimension;/* current position in the output file             */
+ long int pos_curinclude;  /* final position of a line in file                */
+ long int pos_end;         /* final position of a line in file                */
+ long int pos_endsubroutine;
+                           /* final position of a line in file                */
+
+size_t length_last;
+size_t length_first;
+size_t length_v_vallengspec;
+size_t length_v_commoninfile;
+size_t length_v_precision;
+size_t length_v_IntentSpec;
+size_t length_v_initialvalue;
+size_t length_v_readedlistdimension;
+size_t length_a_nomvar;
+size_t length_toprintglob;
+size_t length_tmpvargridname;
+size_t length_ligne_Subloop;
+size_t length_toprint_utilagrif;
+size_t length_toprinttmp_utilchar;
+size_t length_ligne_writedecl;
+size_t length_newname_toamr;
+size_t length_newname_writedecl;
+size_t length_ligne_toamr;
+size_t length_tmpligne_writedecl;
+ int value_char_size;
+ int value_char_size1;
+ int value_char_size2;
+ int value_char_size3;
+
+
+ int inallocate;
+ int infixed;
+ int infree;
+/******************************************************************************/
+/*********** Declaration of externals subroutines *****************************/
+/***************************************************** ************************/
+extern char *fortran_text;
+/******************************************************************************/
+/*********** convert.y ********************************************************/
+/******************************************************************************/
+extern int main(int argc,char *argv[]);
+extern int convert_error(const char *s);
+/******************************************************************************/
+/*********** fortran.y ********************************************************/
+/******************************************************************************/
+extern void process_fortran(const char *input_file);
+extern int fortran_error(const char *s);
+/******************************************************************************/
+/*********** dependfile.c *****************************************************/
+/******************************************************************************/
+extern void Writethedependnbxnbyfile();
+extern void Readthedependnbxnbyfile();
+extern void Writethedependlistofmoduleused(const char *NameTampon );
+extern void Readthedependlistofmoduleused(const char *NameTampon);
+extern void WritedependParameterList(const char *NameTampon );
+extern listparameter *ReaddependParameterList(const char *NameTampon, listparameter *listout);
+extern void Writethedependfile(const char *NameTampon, listvar *input );
+extern listvar *Readthedependfile(const char *NameTampon , listvar *listout);
+extern void Write_Subroutine_For_Alloc();
+extern void Read_Subroutine_For_Alloc();
+extern void Writethedependavailablefile();
+extern void Readthedependavailablefile();
+extern int is_dependfile_created(const char *NameTampon);
+extern void Write_val_max();
+extern void Read_val_max();
+/******************************************************************************/
+/*********** DiversListe.c ****************************************************/
+/******************************************************************************/
+extern void Add_Common_var_1();
+extern listnom  *Addtolistnom(const char *nom, listnom *listin, int value);
+extern listname *Addtolistname(const char *nom, listname *input);
+extern int ModuleIsDefineInInputFile(const char *name);
+extern void Addmoduletothelisttmp(const char *name);
+extern void Add_NameOfModule_1(const char *nom);
+extern void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename);
+extern void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple);
+extern void Add_Include_1(const char *name);
+extern void Add_ImplicitNoneSubroutine_1();
+extern void WriteIncludeDeclaration(FILE* tofile);
+extern void Add_Save_Var_1 (const char *name,listdim *d);
+extern void Add_Save_Var_dcl_1 (listvar *var);
+/******************************************************************************/
+/*********** SubLoopCreation.c ************************************************/
+/******************************************************************************/
+extern void WriteBeginof_SubLoop();
+extern void WriteVariablelist_subloop(char *ligne);
+extern void WriteVariablelist_subloop_Call(char **ligne, size_t line_length);
+extern void WriteVariablelist_subloop_Def(char *ligne);
+extern void WriteHeadofSubroutineLoop();
+extern void closeandcallsubloopandincludeit_0(int suborfun);
+extern void closeandcallsubloop_contains_0();
+/******************************************************************************/
+/*********** toamr.c **********************************************************/
+/******************************************************************************/
+extern void WARNING_CharSize(const variable *var);
+extern const char * tabvarsname(const variable *var);
+extern const char * variablecurgridtabvars(int which_grid);
+extern const char * vargridnametabvars(const variable *var, int iorindice);
+extern const char * vargridcurgridtabvars(const variable *var, int which_grid);
+extern const char * vargridcurgridtabvarswithoutAgrif_Gr(const variable *var);
+extern const char * vargridparam(const variable *var);
+extern void write_probdimagrif_file();
+extern void write_keysagrif_file();
+extern void write_modtypeagrif_file();
+extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,int *InitEmpty);
+extern void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty);
+extern void write_Setnumberofcells_file();
+extern void write_Getnumberofcells_file();
+extern void Write_Alloc_Agrif_Files();
+extern int IndiceInlist(int indic, listindice *listin);
+extern void write_allocation_Common_0();
+extern void write_allocation_Global_0();
+extern void creefichieramr();
+/******************************************************************************/
+/*********** UtilAgrif.c ******************************************************/
+/******************************************************************************/
+extern int Vartonumber(const char *tokname);
+extern int Agrif_in_Tok_NAME(const char *tokname);
+extern void ModifyTheVariableName_0(const char *ident,int lengthname);
+extern void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod);
+extern void AddUseAgrifUtil_0(FILE *fileout);
+extern void AddUseAgrifUtilBeforeCall_0(FILE *fileout);
+extern void NotifyAgrifFunction_0(const char *ident);
+extern void ModifyTheAgrifFunction_0(const char *ident);
+extern void AgriffunctionModify_0(const char *ident,int whichone);
+extern void Instanciation_0(const char *ident);
+/******************************************************************************/
+/*********** UtilCharacter.c **************************************************/
+/******************************************************************************/
+extern void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M],
+                                             listvar * listtosee, int whichone);
+extern const char *ChangeTheInitalvaluebyTabvarsName(const char *nom,listvar *listtoread);
+extern int IsVariableReal(const char *nom);
+extern void IsVarInUseFile(const char *nom);
+extern listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout);
+extern void DecomposeTheName(const char *nom);
+extern void convert2lower(char *lowername, const char* inputname);
+extern int convert2int(const char *name);
+/******************************************************************************/
+/*********** UtilFile.c *******************************************************/
+/******************************************************************************/
+extern FILE * open_for_write (const char *filename);
+extern FILE * open_for_append (const char *filename);
+extern long int setposcur();
+extern long int setposcurname(FILE *fileout);
+extern void copyuse_0(const char *namemodule);
+extern void copyuseonly_0(const char *namemodule);
+/******************************************************************************/
+/*********** UtilFortran.c ****************************************************/
+/******************************************************************************/
+extern void initdimprob(int dimprobmod, const char *nx, const char *ny, const char *nz);
+extern int Variableshouldberemoved(const char *nom);
+extern int variableisglobal(listvar *curvar, listvar *listin);
+extern int VariableIsInListCommon(listvar *curvar,listvar *listin);
+extern int VariableIsInList(listvar *curvar,listvar *listin);
+extern void variableisglobalinmodule(listcouple *listin, const char *module,
+                                                                 FILE *fileout,long int oldposcuruse);
+extern void Write_Word_end_module_0();
+extern void Add_Subroutine_For_Alloc(const char *nom);
+extern void Write_Closing_Module();
+extern int IsTabvarsUseInArgument_0();
+extern int ImplicitNoneInSubroutine();
+extern void Add_Pointer_Var_From_List_1(listvar *listin);
+extern void Add_Pointer_Var_1(char *nom);
+extern int varispointer_0(char *ident);
+extern int VariableIsFunction(const char *ident);
+extern int varistyped_0(char *ident);
+extern void dump_var(const variable* var);
+/******************************************************************************/
+/*********** UtilListe.c ******************************************************/
+/******************************************************************************/
+extern void Init_Variable(variable *var);
+extern listvar * AddListvarToListvar(listvar *l,listvar *glob, int ValueFirstpass);
+extern void CreateAndFillin_Curvar(const char *type, variable *curvar);
+// extern void duplicatelistvar(listvar *orig);
+extern listdim * insertdim(listdim *lin,typedim nom);
+extern void change_dim_char(listdim *lin,listvar * l);
+extern int get_num_dims(const listdim *d);
+extern variable * createvar(const char *nom, listdim *d);
+extern listvar * insertvar(listvar *lin,variable *v);
+extern listvar * settype(const char *nom,listvar *lin);
+extern void printliste(listvar * lin);
+extern int IsinListe(listvar *lin,char *nom);
+extern listname *Insertname(listname *lin,char *nom,int sens);
+extern listname *concat_listname(listname *l1, listname *l2);
+extern void createstringfromlistname(char *ligne, listname *lin);
+extern void printname(listname * lin);
+extern void removeglobfromlist(listname **lin);
+extern void writelistpublic(listname *lin);
+extern void Init_List_Data_Var();
+extern void  addprecision_derivedfromkind(variable *curvar);
+extern int get_cat_var(variable *var);
+/******************************************************************************/
+/*********** UtilNotGridDep.c *************************************************/
+/******************************************************************************/
+extern void Add_NotGridDepend_Var_1 (char *name);
+extern int VarIsNonGridDepend(char *name);
+/******************************************************************************/
+/*********** WorkWithAllocatelist.c *******************************************/
+/******************************************************************************/
+extern void Add_Allocate_Var_1(const char *nom, const char *nommodule);
+extern int IsVarAllocatable_0(const char *ident);
+/******************************************************************************/
+/*********** WorkWithglobliste.c **********************************************/
+/******************************************************************************/
+extern void Add_Globliste_1(listvar *listtoadd);
+extern void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd);
+extern void checkandchangedims(listvar *listsecondpass);
+/******************************************************************************/
+/*********** WorkWithlistdatavariable.c ***************************************/
+/******************************************************************************/
+extern void Add_Data_Var_1 (listvar **curlist,char *name,char *values);
+extern void Add_Data_Var_Names_01 (listvar **curlist,listname *l1, listname *l2);
+/******************************************************************************/
+/*********** WorkWithlistmoduleinfile.c ***************************************/
+/******************************************************************************/
+extern void Save_Length(const char *nom, int whichone);
+extern void Save_Length_int(int val, int whichone);
+/******************************************************************************/
+/*********** WorkWithlistofmodulebysubroutine.c *******************************/
+/******************************************************************************/
+extern void RecordUseModulesVariables();
+extern void  RecordUseModulesUseModulesVariables();
+extern void Add_NameOfModuleUsed_1(char *name);
+extern void Addmoduletothelist(const char *name);
+extern void WriteUsemoduleDeclaration(const char *cursubroutinename);
+/******************************************************************************/
+/*********** WorkWithlistvarindoloop.c ****************************************/
+/******************************************************************************/
+extern void Add_UsedInSubroutine_Var_1 (const char *ident);
+extern void ajoutevarindoloop_definedimension (char *name);
+extern void  ModifyThelistvarindoloop();
+extern void  CompleteThelistvarindoloop();
+extern void Merge_Variables(variable *var1,variable *var2);
+extern void Update_List_Subroutine_Var(listvar *list_to_modify);
+extern void Update_List_Global_Var_From_List_Save_Var();
+extern void Update_List_From_Common_Var(listvar *list_to_modify);
+extern void Update_List_Var(listvar *list_to_modify);
+extern void List_UsedInSubroutine_Var_Update_From_Module_Used();
+extern void Update_NotGridDepend_Var(listvar *list_to_modify);
+extern int LookingForVariableInList(listvar *listin,variable *var);
+extern int LookingForVariableInListGlobal(listvar *listin,variable *var);
+extern int LookingForVariableInListName(listvar *listin,const char *var);
+extern int LookingForVariableInListGlob(listvar *listin,variable *var);
+extern int LookingForVariableInListParamGlob(listparameter *listin, variable *var);
+extern variable *get_variable_in_list_from_name(listvar *listin, const char *name);
+extern void UpdateListDeclarationWithDimensionList();
+extern void Clean_List_UsedInSubroutine_Var();
+extern void Clean_List_ModuleUsed_Var();
+extern void Clean_List_SubroutineDeclaration_Var();
+extern void Clean_List_Global_Var();
+extern void ListClean();
+extern void ListUpdate();
+extern void GiveTypeOfVariables();
+extern void Sort_List_SubroutineArgument_Var();
+extern void IndiceTabvars_Global_Var_Treated(char *nom);
+extern void IndiceTabvars_Global_Var_No_Treated(char *nom);
+extern void UpdateTheRemainingList(listvar *record);
+extern void IndiceTabvars_Common_Var_Treated(char *nom);
+extern void IndiceTabvars_Common_Var_No_Treated(char *nom);
+extern void IndiceTabvarsIdentification();
+extern void New_Allocate_Subroutine_Is_Necessary();
+extern void New_Allocate_Subroutine_For_Common_Is_Necessary();
+extern void NewModule_Creation_0();
+extern void UpdateList_SubroutineWhereAgrifUsed();
+extern void UpdateList_UsedInSubroutine_With_dimension();
+extern void Affiche(listvar *parcours);
+extern int SubInList_ContainsSubroutine();
+extern void update_indicemaxtabvars(variable *var,listindice **Listofindices);
+/******************************************************************************/
+/*********** WorkWithParameterlist.c ******************************************/
+/******************************************************************************/
+extern void Add_GlobalParameter_Var_1(listvar *listin);
+extern void Add_Parameter_Var_1(listvar *listin);
+extern void Add_Dimension_Var_1(listvar *listin);
+/******************************************************************************/
+/*********** WorkWithvarofsubroutineliste.c ***********************************/
+/******************************************************************************/
+extern void Add_SubroutineArgument_Var_1(listvar *listtoadd);
+extern void Add_FunctionType_Var_1(const char *nom);
+// extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd);
+/******************************************************************************/
+/*********** Writedeclarations.c **********************************************/
+/******************************************************************************/
+extern void WriteBeginDeclaration(variable *v,char ligne[LONG_M],int visibility);
+extern void WriteScalarDeclaration(variable *v,char ligne[LONG_M]);
+extern void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok);
+extern void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility );
+extern void WriteLocalParamDeclaration(FILE* tofile);
+extern void WriteFunctionDeclaration(FILE* tofile, int value);
+extern void WriteSubroutineDeclaration(int value);
+extern void WriteArgumentDeclaration_beforecall();
+extern void WriteArgumentDeclaration_Sort(FILE* tofile);
+extern listnom * writedeclarationintoamr(listvar *deb_common, FILE *fileout, variable *var,
+						const char *commonname, listnom *neededparameter, const char *name_common);
+extern void writesub_loopdeclaration_scalar(listvar *deb_common, FILE *fileout);
+extern void writesub_loopdeclaration_tab(listvar *deb_common, FILE *fileout);
+extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl);
+extern void ReWriteDataStatement_0(FILE * filout);
+/******************************************************************************/
+/*********** WriteInFile.c ****************************************************/
+/******************************************************************************/
+extern void tofich_reste (FILE * filout, const char *s, int do_returnline);
+extern void tofich (FILE * filout, const char *s, int do_returnline);
+extern void tofich_blanc (FILE * filout, int size);
+extern void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove);
+extern void RemoveWordCUR_0(FILE * filout, int sizetoremove);
+
+/******************************************************************************/
+/*********** WorkWithlistofcoupled.c **********************************************/
+/******************************************************************************/
+extern int variscoupled_0(const char *ident) ;
+extern const char * getcoupledname_0(const char *ident);
Index: vendors/AGRIF/LIB/dependfile.c
===================================================================
--- vendors/AGRIF/LIB/dependfile.c	(revision 9621)
+++ vendors/AGRIF/LIB/dependfile.c	(revision 9621)
@@ -0,0 +1,974 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include "decl.h"
+
+
+/******************************************************************************/
+/*            Creation and modification of .dependfile                        */
+/******************************************************************************/
+/*  .dependnbxnby            : this file contains tabvars indices of variables*/
+/*                                given in agrif.in as number of cells        */
+/*  .dependuse<module>       : this file contains all modules used in the     */
+/*                                current file                                */
+/*  .dependparameter<module> : this file contains all parmeters defined in    */
+/*                                the current file                            */
+/*  .depend<module name>     : this file contains all globals variables       */
+/*                                informations (name, dim, etc ...)           */
+/*  .dependavailable         : this file contains all tabvars indices which   */
+/*                                are not used.                               */
+/******************************************************************************/
+
+
+/******************************************************************************/
+/*                 Writethedependnbxnbyfile                                   */
+/******************************************************************************/
+/* This subroutine is used to create the .dependnbxnby                        */
+/******************************************************************************/
+/*                                                                            */
+/*                     .dependnbxnby                                          */
+/*                                                                            */
+/*                     nbmaillesX                                             */
+/*                     nbmaillesY                                             */
+/*                     nbmaillesZ                                             */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependnbxnbyfile()
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  int out;
+
+  // We look in 'List_Global_Var' for all the variables of the current file to parse
+  parcours = List_Global_Var;
+  out = 0;
+  while (parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesX) ) out = 1;
+     else parcours = parcours->suiv;
+  }
+  if ( out == 0 )
+  {
+     parcours =List_Common_Var;
+     while (parcours && out == 0 )
+     {
+        if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesX) ) out = 1;
+        else parcours = parcours->suiv;
+     }
+  }
+  NbMailleXDefined = 0;
+  if ( out == 1 )
+  {
+     NbMailleXDefined = 1;
+     sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+     dependfileoutput = fopen(dependfilename, "w");
+
+     fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+     IndicenbmaillesX = parcours->var->v_indicetabvars;
+
+     if ( dimprob > 1 )
+     {
+        parcours =List_Global_Var;
+        out = 0;
+        while (parcours && out == 0 )
+        {
+           if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesY) ) out = 1;
+           else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+           parcours =List_Common_Var;
+           while (parcours && out == 0 )
+           {
+              if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesY) ) out = 1;
+              else parcours = parcours->suiv;
+           }
+        }
+        if ( out == 1 )
+        {
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+           IndicenbmaillesY = parcours->var->v_indicetabvars;
+        }
+     }
+
+     if ( dimprob > 2 )
+     {
+        parcours =List_Global_Var;
+        out = 0;
+        while (parcours && out == 0 )
+        {
+           if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesZ) ) out = 1;
+           else parcours = parcours->suiv;
+        }
+        if ( out == 0 )
+        {
+           parcours =List_Common_Var;
+           while (parcours && out == 0 )
+           {
+              if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesZ) ) out = 1;
+              else parcours = parcours->suiv;
+           }
+        }
+        if ( out == 1 )
+        {
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+           IndicenbmaillesZ = parcours->var->v_indicetabvars;
+        }
+     }
+
+     if ( out == 1 ) fclose(dependfileoutput);
+   }
+}
+
+/******************************************************************************/
+/*                 Readthedependnbxnbyfile                                    */
+/******************************************************************************/
+/* This subroutine is used to create the .dependnbxnby                        */
+/******************************************************************************/
+/*                                                                            */
+/*                     .dependnbxnby                                          */
+/*                                                                            */
+/*                     nbmaillesX                                             */
+/*                     nbmaillesY                                             */
+/*                     nbmaillesZ                                             */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependnbxnbyfile()
+{
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependnbxnby", work_dir);
+    if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+    {
+        fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX);
+        if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY);
+        if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ);
+        fclose(dependfileoutput);
+    }
+}
+
+/******************************************************************************/
+/*                     Writethedependlistofmoduleused                         */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependlistofmoduleused(const char *NameTampon )
+{
+    FILE *dependfileoutput;
+    listusemodule *parcours;
+    char lowername[LONG_VNAME];
+
+    if ( ! List_NameOfModuleUsed ) return;
+
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+    dependfileoutput = fopen(dependfilename, "w");
+
+    parcours = List_NameOfModuleUsed;
+    while (parcours)
+    {
+    if ( !strcasecmp(lowername,parcours->u_modulename) &&
+         !strcasecmp(parcours->u_cursubroutine,"") )
+    {
+        // We look in 'List_NameOfModuleUsed' for all the variables of the current file to parse
+        fprintf(dependfileoutput,"%s\n",parcours->u_usemodule);
+    }
+    parcours = parcours->suiv;
+    }
+    fclose(dependfileoutput);
+}
+
+/******************************************************************************/
+/*                    Readthedependlistofmoduleused                           */
+/******************************************************************************/
+/* This subroutine is used to create the .dependuse<module>                   */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependuse<name>                                             */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependlistofmoduleused(const char *NameTampon)
+{
+  FILE *dependfileoutput;
+  listusemodule *parcours;
+  char lowername[LONG_VNAME];
+
+  tmpuselocallist = (listusemodule *)NULL;
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL)
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listusemodule *)calloc(1,sizeof(listusemodule));
+         fscanf(dependfileoutput,"%s\n",parcours->u_usemodule);
+
+         parcours->suiv = tmpuselocallist;
+         tmpuselocallist = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                        WritedependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+void WritedependParameterList(const char *NameTampon )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  char lowername[LONG_VNAME];
+
+  if ( List_GlobalParameter_Var )
+  {
+     convert2lower(lowername, NameTampon);
+     sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+     dependfileoutput = fopen(dependfilename, "w");
+     parcours = List_GlobalParameter_Var;
+     while (parcours)
+     {
+        if ( !strcasecmp(lowername, parcours->var->v_modulename) )
+        {
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+        }
+        parcours = parcours->suiv;
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                         ReaddependParameterList                            */
+/******************************************************************************/
+/* This subroutine is used to create the .dependparameter<name>               */
+/******************************************************************************/
+/*                                                                            */
+/*               .dependparameter<name>                                       */
+/*                                                                            */
+/*               mod1                                                         */
+/*               mod2                                                         */
+/*                                                                            */
+/******************************************************************************/
+listparameter *ReaddependParameterList(const char *NameTampon,listparameter *listout)
+{
+  FILE *dependfileoutput;
+  listparameter *parcours;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename,"r"))!=NULL)
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listparameter *)calloc(1,sizeof(listparameter));
+         fscanf(dependfileoutput,"%s\n",parcours->p_name);
+         fscanf(dependfileoutput,"%s\n",parcours->p_modulename);
+
+         parcours->suiv = listout;
+         listout = parcours;
+
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+  return listout;
+}
+
+/******************************************************************************/
+/*                   Writethedependfile                                       */
+/******************************************************************************/
+/* This subroutine is used to create the .depend<name>                        */
+/******************************************************************************/
+/*                                                                            */
+/*                     .depend<name>                                          */
+/*                                                                            */
+/*                      REAL                                                  */
+/*                      Variable                                              */
+/*                      char dimension or T                                   */
+/*                      table dimension                                       */
+/*                      is type given                                         */
+/*                      precision or T                                        */
+/*                      initial value or T                                    */
+/*                      indice in the tabvars                                 */
+/*                      listdimension or T                                    */
+/*                      -------------------------                             */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependfile(const char *NameTampon, listvar *input )
+{
+  FILE *dependfileoutput;
+  listvar *parcours;
+  listdim *dims;
+  char ligne[LONG_M];
+  char listdimension[LONG_M];
+  char curname[LONG_M];
+  char lowername[LONG_VNAME];
+  int out;
+
+  if ( input )
+  {
+    convert2lower(lowername, NameTampon);
+    sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename,"w");
+  // We look in 'input' for all the variables of the current file to parse
+  parcours =input;
+  out = 0;
+  strcpy(curname,"");
+  while (parcours && out == 0 )
+  {
+     if ( !strcasecmp(parcours->var->v_modulename, lowername) ||
+          !strcasecmp(parcours->var->v_commonname, lowername) )
+     {
+        /*                                                                    */
+        if (  strcasecmp(curname,"") &&
+             !strcasecmp(curname,parcours->var->v_nomvar) ) out = 1 ;
+        if ( !strcasecmp(curname,"") ) strcpy(curname,parcours->var->v_nomvar);
+        /*                                                                    */
+        if ( out == 0 )
+        {
+           /********** TYPEVAR ************************************************/
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_catvar);
+           /********** NOMVAR *************************************************/
+           fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           /********** DIMCHAR ************************************************/
+           if ( strcasecmp(parcours->var->v_dimchar, "") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_dimchar);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** COMMONINFILE *******************************************/
+           if ( strcasecmp(parcours->var->v_commoninfile,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_commoninfile);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** COMMONNAME *********************************************/
+           if ( strcasecmp(parcours->var->v_commonname,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_commonname);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** MODULENAME *********************************************/
+           if ( strcasecmp(parcours->var->v_modulename,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** NBDIM **************************************************/
+/*           fprintf(dependfileoutput,"%d\n",parcours->var->v_nbdim);*/
+           /********** DIMENSIONGIVEN *****************************************/
+/*           fprintf(dependfileoutput,"%d\n",parcours->var->v_dimensiongiven);*/
+           /********** ALLOCATABLE ********************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_allocatable);
+           /********** TARGET ********************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_target);
+           /********** POINTERDECLARE *****************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_pointerdeclare);
+           /********** PRECISION **********************************************/
+           if ( strcasecmp(parcours->var->v_precision,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_precision);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** INITIALVALUE *******************************************/
+/*           if ( strcasecmp(parcours->var->v_initialvalue,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_initialvalue);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }*/
+           /********** NAMEINTYPENAME *****************************************/
+           if ( strcasecmp(parcours->var->v_nameinttypename,"") )
+           {
+              fprintf(dependfileoutput,"%s\n",parcours->var->v_nameinttypename);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /********** PRIVATE *****************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_PrivateDeclare);
+
+           /********** INDICETABVARS ******************************************/
+           fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars);
+           /********** READEDLISTDIMENSION ************************************/
+           if ( parcours->var->v_dimensiongiven == 1 )
+           {
+              dims = parcours->var->v_dimension;
+              strcpy(listdimension,"");
+              while (dims)
+              {
+                 sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
+                 strcat(listdimension,ligne);
+                 if ( dims->suiv )
+                 {
+                    strcat(listdimension,",");
+                 }
+                 dims = dims->suiv;
+              }
+              Save_Length(listdimension,15);
+              fprintf(dependfileoutput,"%s\n",listdimension);
+           }
+           else
+           {
+              fprintf(dependfileoutput,"T\n");
+           }
+           /*******************************************************************/
+           fprintf(dependfileoutput,"------------------------\n");
+        }
+     }
+     parcours = parcours->suiv;
+  }
+  fclose(dependfileoutput);
+  }
+}
+
+/******************************************************************************/
+/*                         Readthedependfile                                  */
+/******************************************************************************/
+/* This subroutine is used to read the .dependfile<name> and to insert new    */
+/*    information in the listout list.                                        */
+/******************************************************************************/
+/*                                                                            */
+/*           .dependmodule -------->                      = list of var       */
+/*                                                                            */
+/*        not.dependmodule -------->                                          */
+/*                                                                            */
+/******************************************************************************/
+listvar *Readthedependfile(const char *NameTampon , listvar *listout)
+{
+  FILE *dependfileoutput;
+  listvar *parcours0;
+  listvar *parcours;
+  listvar *parcoursprec;
+  char nothing[LONG_M];
+  char lowername[LONG_VNAME];
+  size_t i;
+
+  parcoursprec = (listvar *)NULL;
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  if ((dependfileoutput = fopen(dependfilename, "r"))==NULL)
+  {
+    /* if the file doesn't exist it means that it is the first time           */
+    /*    we tried to parse this file                                         */
+  }
+  else
+  {
+    /* if the file exist we should verify that this file has changed          */
+      while (!feof(dependfileoutput))
+      {
+         parcours=(listvar *)calloc(1,sizeof(listvar));
+         parcours->var=(variable *)calloc(1,sizeof(variable));
+         /*                                                                   */
+         Init_Variable(parcours->var);
+         /*                                                                   */
+           /********** TYPEVAR ************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_typevar);
+           /********** CATVAR ************************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_catvar);
+           /********** NOMVAR *************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_nomvar);
+           /********** DIMCHAR ************************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_dimchar);
+         if ( !strcasecmp(parcours->var->v_dimchar,"T") )
+         {
+            strcpy(parcours->var->v_dimchar,"");
+         }
+           /********** COMMONINFILE *******************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_commoninfile);
+         if ( !strcasecmp(parcours->var->v_commoninfile,"T") )
+         {
+            strcpy(parcours->var->v_commoninfile,"");
+         }
+           /********** COMMONNAME *********************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_commonname);
+         if ( !strcasecmp(parcours->var->v_commonname,"T") )
+         {
+            strcpy(parcours->var->v_commonname,"");
+         }
+           /********** MODULENAME *********************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_modulename);
+
+         if ( !strcasecmp(parcours->var->v_modulename,"T") )
+         {
+            strcpy(parcours->var->v_modulename,"");
+         }
+
+
+           /********** NBDIM **************************************************/
+/*         fscanf(dependfileoutput,"%d\n",&parcours->var->v_nbdim);*/
+           /********** DIMENSIONGIVEN *****************************************/
+/*         fscanf(dependfileoutput,"%d\n",&parcours->var->v_dimensiongiven);*/
+           /********** ALLOCATABLE ********************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_allocatable);
+         if ( parcours->var->v_allocatable == 1 )
+         {
+            Add_Allocate_Var_1(parcours->var->v_nomvar, parcours->var->v_commonname);
+         }
+           /********** TARGET ********************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_target);
+
+           /********** POINTERDECLARE *****************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_pointerdeclare);
+         if ( parcours->var->v_pointerdeclare == 1 )
+         {
+            Add_Pointer_Var_1(parcours->var->v_nomvar);
+         }
+           /********** PRECISION **********************************************/
+         fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_precision);
+         if ( !strcasecmp(parcours->var->v_precision,"T") )
+         {
+            strcpy(parcours->var->v_precision,"");
+         }
+           /********** INITIALVALUE *******************************************/
+/*         fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_initialvalue);
+         if ( !strcasecmp(parcours->var->v_initialvalue,"T") )
+         {
+            strcpy(parcours->var->v_initialvalue,"");
+         }*/
+           /********** NAMEINTYPENAME *****************************************/
+         fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_nameinttypename);
+         if ( !strcasecmp(parcours->var->v_nameinttypename,"T") )
+         {
+            strcpy(parcours->var->v_nameinttypename,"");
+         }
+           /********** PRIVATE *****************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_PrivateDeclare);
+
+           /********** INDICETABVARS ******************************************/
+         fscanf(dependfileoutput,"%d\n",&parcours->var->v_indicetabvars);
+           /********** READEDLISTDIMENSION ************************************/
+         fscanf(dependfileoutput,"%s\n",parcours->var->v_readedlistdimension);
+         if ( !strcasecmp(parcours->var->v_readedlistdimension,"T") )
+         {
+            strcpy(parcours->var->v_readedlistdimension,"");
+         }
+         else
+         {
+            parcours->var->v_dimensiongiven = 1;
+            parcours->var->v_nbdim = 1;
+            i = 1;
+            /*                                                                */
+            while ( i < strlen(parcours->var->v_readedlistdimension) )
+            {
+               if ( parcours->var->v_readedlistdimension[i] == ',' )
+               {
+                  parcours->var->v_nbdim = parcours->var->v_nbdim + 1 ;
+               }
+               /*                                                             */
+               i=i+1;
+            }
+         }
+           /*******************************************************************/
+         fscanf(dependfileoutput,"%s\n",nothing);
+         parcours->suiv = NULL;
+         if (parcours->var->v_PrivateDeclare == 0)
+         {
+         if ( !listout )
+         {
+            listout = parcours;
+            parcoursprec = parcours;
+         }
+         else
+         {
+            if ( parcoursprec )
+            {
+               parcoursprec->suiv = parcours;
+               parcoursprec = parcours;
+            }
+            else
+            {
+               parcours0 = listout;
+               while ( parcours0->suiv ) parcours0=parcours0->suiv;
+               parcours0->suiv = parcours;
+               parcoursprec = parcours0->suiv;
+            }
+         }
+         }
+         parcours = NULL;
+      }
+      fclose(dependfileoutput);
+  }
+  return listout;
+}
+
+void Write_Subroutine_For_Alloc()
+{
+   FILE *dependfileoutput;
+   listnom *parcours;
+
+   if ( List_Subroutine_For_Alloc )
+   {
+      sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+      if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+      {
+         parcours = List_Subroutine_For_Alloc;
+         while (parcours)
+         {
+            fprintf(dependfileoutput,"%s\n",parcours->o_nom);
+            parcours = parcours->suiv;
+         }
+         fclose(dependfileoutput);
+      }
+   }
+}
+
+void Read_Subroutine_For_Alloc()
+{
+    FILE *dependfileoutput;
+    listnom *parcours;
+    listnom *ref;
+
+    ref = (listnom*) NULL;
+    sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir);
+
+    if ( (dependfileoutput=fopen(dependfilename, "r")) != NULL )
+    {
+        List_Subroutine_For_Alloc = (listnom*) NULL;
+        while ( !feof(dependfileoutput) )
+        {
+            parcours = (listnom*) calloc(1,sizeof(listnom));
+            strcpy(parcours->o_nom,"");
+
+            fscanf(dependfileoutput,"%s\n",parcours->o_nom);
+            parcours->suiv = NULL;
+
+            if ( !List_Subroutine_For_Alloc )
+            {
+                List_Subroutine_For_Alloc = parcours;
+            }
+            else
+            {
+                ref->suiv = parcours;
+            }
+            ref = parcours;
+        }
+        fclose(dependfileoutput);
+    }
+}
+
+/******************************************************************************/
+/*                        Writethedependavailablefile                         */
+/******************************************************************************/
+/* This subroutine is used to write the .dependfileavailable file             */
+/******************************************************************************/
+/*                                                                            */
+/*                                  .dependavailable                          */
+/*     tabvars(1) = var1                                                      */
+/*     tabvars(3) = var1                  2                                   */
+/*     tabvars(4) = var1         =====>   5                                   */
+/*     tabvars(6) = var1                                                      */
+/*     tabvars(7) = var1                                                      */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Writethedependavailablefile()
+{
+    FILE *dependfileoutput;
+    listindice *parcours;
+    int i;
+
+    sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        /* We are looking for all the indices of the Listofavailableindices      */
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            parcours = Listofavailableindices_glob[i];
+            while (parcours)
+            {
+                if ( parcours->i_indice != 0 )
+                {
+                    fprintf(dependfileoutput,"%d %d\n",i,parcours->i_indice);
+                }
+                parcours = parcours->suiv;
+            }
+        }
+        fclose(dependfileoutput);
+    }
+}
+
+/******************************************************************************/
+/*                        Readthedependavailablefile                          */
+/******************************************************************************/
+/* This subroutine is used to read the .dependfileavailable file              */
+/******************************************************************************/
+/*                                                                            */
+/*                                  .dependavailable                          */
+/*     tabvars(1) = var1                                                      */
+/*     tabvars(3) = var1                  2                                   */
+/*     tabvars(4) = var1         =====>   5  ==> Listofavailableindices       */
+/*     tabvars(6) = var1                                                      */
+/*     tabvars(7) = var1                                                      */
+/*                                                                            */
+/*                                                                            */
+/*                                                                            */
+/******************************************************************************/
+void Readthedependavailablefile()
+{
+  FILE *dependfileoutput;
+  listindice *parcours;
+  int current_cat;
+
+  sprintf(dependfilename, "%s/.dependavailable", work_dir);
+
+  if ((dependfileoutput=fopen(dependfilename, "r"))!=NULL)
+  {
+     /* We are looking for all the indices of the Listofavailableindices      */
+     Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+     while (!feof(dependfileoutput))
+     {
+        parcours=(listindice *)calloc(1,sizeof(listindice));
+        fscanf(dependfileoutput,"%d %d\n",&current_cat,&parcours->i_indice);
+        if ( parcours->i_indice != 0 && parcours->i_indice < 10000000 )
+        {
+           parcours -> suiv = Listofavailableindices_glob[current_cat];
+           Listofavailableindices_glob[current_cat] = parcours;
+        }
+        else
+        {
+           free(parcours);
+        }
+     }
+     fclose(dependfileoutput);
+  }
+}
+
+
+/******************************************************************************/
+/*                       is_dependfile_created                                */
+/******************************************************************************/
+/* This subroutine is used to know if the .depend<NameTampon> exist           */
+/*    it means if the file has been ever parsed                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+int is_dependfile_created(const char *NameTampon)
+{
+  FILE *dependfileoutput;
+  char lowername[LONG_VNAME];
+
+  convert2lower(lowername, NameTampon);
+  sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername);
+
+  dependfileoutput = fopen(dependfilename, "r");
+
+  if ( (dependfileoutput = fopen(dependfilename, "r")) != NULL )
+  {
+    fclose(dependfileoutput);
+    return 1;
+  }
+  else
+    return 0;
+}
+
+void Write_val_max()
+{
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL)
+    {
+        fprintf(dependfileoutput,"length_last\n");
+        fprintf(dependfileoutput,"%lu\n", length_last);
+        fprintf(dependfileoutput,"length_first\n");
+        fprintf(dependfileoutput,"%lu\n", length_first);
+        fprintf(dependfileoutput,"length_v_vallengspec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_vallengspec);
+        fprintf(dependfileoutput,"length_v_commoninfile\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_commoninfile);
+        fprintf(dependfileoutput,"length_v_precision\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_precision);
+        fprintf(dependfileoutput,"length_v_IntentSpec\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_IntentSpec);
+        fprintf(dependfileoutput,"length_v_initialvalue\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_initialvalue);
+        fprintf(dependfileoutput,"length_v_readedlistdimension\n");
+        fprintf(dependfileoutput,"%lu\n", length_v_readedlistdimension);
+        fprintf(dependfileoutput,"length_a_nomvar\n");
+        fprintf(dependfileoutput,"%lu\n", length_a_nomvar);
+        fprintf(dependfileoutput,"length_toprintglob\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprintglob);
+        fprintf(dependfileoutput,"Size_char0d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size);
+        fprintf(dependfileoutput,"Size_char1d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size1);
+        fprintf(dependfileoutput,"Size_char2d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size2);
+        fprintf(dependfileoutput,"Size_char3d\n");
+        fprintf(dependfileoutput,"%d\n",value_char_size3);
+        fprintf(dependfileoutput,"length_tmpvargridname\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpvargridname);
+        fprintf(dependfileoutput,"length_ligne_Subloop\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_Subloop);
+        fprintf(dependfileoutput,"length_toprint_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprint_utilagrif);
+        fprintf(dependfileoutput,"length_toprinttmp_utilchar\n");
+        fprintf(dependfileoutput,"%lu\n", length_toprinttmp_utilchar);
+        fprintf(dependfileoutput,"length_ligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_writedecl);
+        fprintf(dependfileoutput,"length_newname_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_toamr);
+        fprintf(dependfileoutput,"length_newname_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_newname_writedecl);
+        fprintf(dependfileoutput,"length_ligne_toamr\n");
+        fprintf(dependfileoutput,"%lu\n", length_ligne_toamr);
+        fprintf(dependfileoutput,"length_tmpligne_writedecl\n");
+        fprintf(dependfileoutput,"%lu\n", length_tmpligne_writedecl);
+
+        fclose(dependfileoutput);
+    }
+}
+
+
+void Read_val_max()
+{
+    char nothing[LONG_M];
+    FILE *dependfileoutput;
+
+    sprintf(dependfilename, "%s/.dependvalmax", work_dir);
+
+    if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL)
+    {
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_last);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_first);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_vallengspec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_commoninfile);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_precision);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_IntentSpec);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_initialvalue);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_v_readedlistdimension);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_a_nomvar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprintglob);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size1);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size2);
+       fscanf(dependfileoutput,"%s\n", nothing);
+       fscanf(dependfileoutput,"%d\n", &value_char_size3);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpvargridname);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_Subloop);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprint_utilagrif);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_toprinttmp_utilchar);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_newname_writedecl);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_ligne_toamr);
+       fscanf(dependfileoutput,"%s\n",nothing);
+       fscanf(dependfileoutput,"%lu\n", &length_tmpligne_writedecl);
+
+       fclose(dependfileoutput);
+    }
+}
Index: vendors/AGRIF/LIB/fortran.c
===================================================================
--- vendors/AGRIF/LIB/fortran.c	(revision 9621)
+++ vendors/AGRIF/LIB/fortran.c	(revision 9621)
@@ -0,0 +1,10440 @@
+/* A Bison parser, made by GNU Bison 2.7.  */
+
+/* Bison implementation for Yacc-like parsers in C
+   
+      Copyright (C) 1984, 1989-1990, 2000-2012 Free Software Foundation, Inc.
+   
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+   
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+   
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+   
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Push parsers.  */
+#define YYPUSH 0
+
+/* Pull parsers.  */
+#define YYPULL 1
+
+
+/* Substitute the variable and function names.  */
+#define yyparse         fortran_parse
+#define yylex           fortran_lex
+#define yyerror         fortran_error
+#define yylval          fortran_lval
+#define yychar          fortran_char
+#define yydebug         fortran_debug
+#define yynerrs         fortran_nerrs
+
+/* Copy the first part of user declarations.  */
+/* Line 371 of yacc.c  */
+#line 36 "fortran.y"
+
+#define YYMAXDEPTH 1000
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+extern int line_num_input;
+extern char *fortran_text;
+
+char c_selectorname[LONG_M];
+char ligne[LONG_M];
+char truename[LONG_VNAME];
+char identcopy[LONG_VNAME];
+int c_selectorgiven=0;
+listvar *curlistvar;
+typedim c_selectordim;
+listcouple *coupletmp;
+int removeline=0;
+listvar *test;
+
+int fortran_error(const char *s)
+{
+    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+    exit(1);
+}
+
+
+/* Line 371 of yacc.c  */
+#line 104 "fortran.tab.c"
+
+# ifndef YY_NULL
+#  if defined __cplusplus && 201103L <= __cplusplus
+#   define YY_NULL nullptr
+#  else
+#   define YY_NULL 0
+#  endif
+# endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+#if YYDEBUG
+extern int fortran_debug;
+#endif
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_NEQV = 258,
+     TOK_EQV = 259,
+     TOK_XOR = 260,
+     TOK_OR = 261,
+     TOK_AND = 262,
+     TOK_NOT = 263,
+     TOK_NE = 264,
+     TOK_EQ = 265,
+     TOK_GE = 266,
+     TOK_LE = 267,
+     TOK_GT = 268,
+     TOK_LT = 269,
+     TOK_DSLASH = 270,
+     TOK_SLASH = 271,
+     TOK_DASTER = 272,
+     TOK_SEMICOLON = 273,
+     TOK_PARAMETER = 274,
+     TOK_RESULT = 275,
+     TOK_ONLY = 276,
+     TOK_INCLUDE = 277,
+     TOK_SUBROUTINE = 278,
+     TOK_PROGRAM = 279,
+     TOK_FUNCTION = 280,
+     TOK_FORMAT = 281,
+     TOK_MAX = 282,
+     TOK_TANH = 283,
+     TOK_WHERE = 284,
+     TOK_ELSEWHEREPAR = 285,
+     TOK_ELSEWHERE = 286,
+     TOK_ENDWHERE = 287,
+     TOK_MAXVAL = 288,
+     TOK_TRIM = 289,
+     TOK_NULL_PTR = 290,
+     TOK_SUM = 291,
+     TOK_SQRT = 292,
+     TOK_CASE = 293,
+     TOK_SELECTCASE = 294,
+     TOK_FILE = 295,
+     TOK_UNIT = 296,
+     TOK_FMT = 297,
+     TOK_NML = 298,
+     TOK_END = 299,
+     TOK_EOR = 300,
+     TOK_ERR = 301,
+     TOK_EXIST = 302,
+     TOK_MIN = 303,
+     TOK_FLOAT = 304,
+     TOK_EXP = 305,
+     TOK_COS = 306,
+     TOK_COSH = 307,
+     TOK_ACOS = 308,
+     TOK_NINT = 309,
+     TOK_CYCLE = 310,
+     TOK_SIN = 311,
+     TOK_SINH = 312,
+     TOK_ASIN = 313,
+     TOK_EQUIVALENCE = 314,
+     TOK_BACKSPACE = 315,
+     TOK_LOG = 316,
+     TOK_TAN = 317,
+     TOK_ATAN = 318,
+     TOK_RECURSIVE = 319,
+     TOK_ABS = 320,
+     TOK_MOD = 321,
+     TOK_SIGN = 322,
+     TOK_MINLOC = 323,
+     TOK_MAXLOC = 324,
+     TOK_EXIT = 325,
+     TOK_MINVAL = 326,
+     TOK_PUBLIC = 327,
+     TOK_PRIVATE = 328,
+     TOK_ALLOCATABLE = 329,
+     TOK_RETURN = 330,
+     TOK_THEN = 331,
+     TOK_ELSEIF = 332,
+     TOK_ELSE = 333,
+     TOK_ENDIF = 334,
+     TOK_PRINT = 335,
+     TOK_PLAINGOTO = 336,
+     TOK_LOGICALIF = 337,
+     TOK_PLAINDO = 338,
+     TOK_CONTAINS = 339,
+     TOK_ENDDO = 340,
+     TOK_MODULE = 341,
+     TOK_ENDMODULE = 342,
+     TOK_WHILE = 343,
+     TOK_CONCURRENT = 344,
+     TOK_ALLOCATE = 345,
+     TOK_OPEN = 346,
+     TOK_CLOSE = 347,
+     TOK_INQUIRE = 348,
+     TOK_WRITE = 349,
+     TOK_FLUSH = 350,
+     TOK_READ = 351,
+     TOK_REWIND = 352,
+     TOK_DEALLOCATE = 353,
+     TOK_NULLIFY = 354,
+     TOK_DIMENSION = 355,
+     TOK_ENDSELECT = 356,
+     TOK_EXTERNAL = 357,
+     TOK_INTENT = 358,
+     TOK_INTRINSIC = 359,
+     TOK_NAMELIST = 360,
+     TOK_DEFAULT = 361,
+     TOK_OPTIONAL = 362,
+     TOK_POINTER = 363,
+     TOK_CONTINUE = 364,
+     TOK_SAVE = 365,
+     TOK_TARGET = 366,
+     TOK_IMPLICIT = 367,
+     TOK_NONE = 368,
+     TOK_CALL = 369,
+     TOK_STAT = 370,
+     TOK_POINT_TO = 371,
+     TOK_COMMON = 372,
+     TOK_GLOBAL = 373,
+     TOK_LEFTAB = 374,
+     TOK_RIGHTAB = 375,
+     TOK_PAUSE = 376,
+     TOK_PROCEDURE = 377,
+     TOK_STOP = 378,
+     TOK_REAL8 = 379,
+     TOK_FOURDOTS = 380,
+     TOK_HEXA = 381,
+     TOK_ASSIGNTYPE = 382,
+     TOK_OUT = 383,
+     TOK_INOUT = 384,
+     TOK_IN = 385,
+     TOK_USE = 386,
+     TOK_TRUE = 387,
+     TOK_FALSE = 388,
+     TOK_LABEL = 389,
+     TOK_TYPE = 390,
+     TOK_TYPEPAR = 391,
+     TOK_ENDTYPE = 392,
+     TOK_REAL = 393,
+     TOK_INTEGER = 394,
+     TOK_LOGICAL = 395,
+     TOK_DOUBLEPRECISION = 396,
+     TOK_ENDSUBROUTINE = 397,
+     TOK_ENDFUNCTION = 398,
+     TOK_ENDPROGRAM = 399,
+     TOK_ENDUNIT = 400,
+     TOK_CHARACTER = 401,
+     TOK_CHAR_CONSTANT = 402,
+     TOK_CHAR_CUT = 403,
+     TOK_DATA = 404,
+     TOK_CHAR_MESSAGE = 405,
+     TOK_CSTREAL = 406,
+     TOK_COMPLEX = 407,
+     TOK_DOUBLECOMPLEX = 408,
+     TOK_NAME = 409,
+     TOK_CSTINT = 410
+   };
+#endif
+
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+{
+/* Line 387 of yacc.c  */
+#line 65 "fortran.y"
+
+    char        na[LONG_M];
+    listdim     *d;
+    listvar     *l;
+    listcouple  *lc;
+    listname    *lnn;
+    typedim     dim1;
+    variable    *v;
+
+
+/* Line 387 of yacc.c  */
+#line 310 "fortran.tab.c"
+} YYSTYPE;
+# define YYSTYPE_IS_TRIVIAL 1
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+#endif
+
+extern YYSTYPE fortran_lval;
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void *YYPARSE_PARAM);
+#else
+int fortran_parse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int fortran_parse (void);
+#else
+int fortran_parse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* Copy the second part of user declarations.  */
+
+/* Line 390 of yacc.c  */
+#line 338 "fortran.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(Msgid) dgettext ("bison-runtime", Msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(Msgid) Msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(E) ((void) (E))
+#else
+# define YYUSE(E) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(N) (N)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int yyi)
+#else
+static int
+YYID (yyi)
+    int yyi;
+#endif
+{
+  return yyi;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+      /* Use EXIT_SUCCESS as a witness for stdlib.h.  */
+#     ifndef EXIT_SUCCESS
+#      define EXIT_SUCCESS 0
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined EXIT_SUCCESS \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef EXIT_SUCCESS
+#    define EXIT_SUCCESS 0
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss_alloc;
+  YYSTYPE yyvs_alloc;
+};
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+# define YYCOPY_NEEDED 1
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack_alloc, Stack)				\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack_alloc, Stack, yysize);			\
+	Stack = &yyptr->Stack_alloc;					\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
+/* Copy COUNT objects from SRC to DST.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(Dst, Src, Count) \
+      __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
+#  else
+#   define YYCOPY(Dst, Src, Count)              \
+      do                                        \
+        {                                       \
+          YYSIZE_T yyi;                         \
+          for (yyi = 0; yyi < (Count); yyi++)   \
+            (Dst)[yyi] = (Src)[yyi];            \
+        }                                       \
+      while (YYID (0))
+#  endif
+# endif
+#endif /* !YYCOPY_NEEDED */
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   6268
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  169
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  206
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  597
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  1051
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   410
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+     166,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,   168,     2,     2,
+     162,   163,    21,    19,     3,    20,     2,   167,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     4,     2,
+     164,     5,   165,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     6,     7,
+       8,     9,    10,    11,    12,    13,    14,    15,    16,    17,
+      18,    22,    23,    24,    25,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,    36,    37,    38,    39,    40,
+      41,    42,    43,    44,    45,    46,    47,    48,    49,    50,
+      51,    52,    53,    54,    55,    56,    57,    58,    59,    60,
+      61,    62,    63,    64,    65,    66,    67,    68,    69,    70,
+      71,    72,    73,    74,    75,    76,    77,    78,    79,    80,
+      81,    82,    83,    84,    85,    86,    87,    88,    89,    90,
+      91,    92,    93,    94,    95,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,   106,   107,   108,   109,   110,
+     111,   112,   113,   114,   115,   116,   117,   118,   119,   120,
+     121,   122,   123,   124,   125,   126,   127,   128,   129,   130,
+     131,   132,   133,   134,   135,   136,   137,   138,   139,   140,
+     141,   142,   143,   144,   145,   146,   147,   148,   149,   150,
+     151,   152,   153,   154,   155,   156,   157,   158,   159,   160,
+     161
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint16 yyprhs[] =
+{
+       0,     0,     3,     4,     7,     9,    11,    14,    16,    19,
+      21,    25,    28,    31,    33,    37,    41,    44,    47,    51,
+      53,    54,    55,    57,    58,    61,    66,    69,    75,    78,
+      80,    83,    85,    87,    88,    91,    95,    96,    99,   103,
+     105,   109,   111,   113,   116,   121,   124,   127,   132,   135,
+     137,   139,   141,   143,   145,   147,   149,   151,   153,   158,
+     162,   166,   169,   172,   173,   175,   177,   179,   181,   183,
+     185,   187,   189,   191,   193,   195,   197,   199,   201,   203,
+     205,   207,   209,   211,   213,   215,   217,   219,   221,   223,
+     225,   229,   233,   239,   241,   245,   249,   252,   257,   259,
+     263,   264,   266,   269,   273,   275,   277,   280,   282,   286,
+     291,   296,   305,   307,   311,   314,   318,   324,   328,   330,
+     331,   334,   336,   341,   345,   348,   352,   356,   360,   364,
+     365,   367,   370,   374,   380,   384,   386,   392,   398,   401,
+     405,   408,   412,   414,   416,   420,   424,   427,   431,   437,
+     439,   442,   444,   448,   451,   453,   457,   458,   460,   462,
+     466,   470,   473,   475,   479,   482,   485,   491,   498,   499,
+     502,   505,   509,   513,   514,   517,   522,   526,   530,   535,
+     538,   540,   542,   544,   546,   548,   550,   552,   553,   556,
+     558,   562,   563,   566,   570,   572,   576,   579,   583,   585,
+     587,   589,   591,   593,   594,   598,   599,   601,   605,   607,
+     611,   613,   615,   617,   620,   622,   627,   629,   631,   633,
+     635,   637,   639,   641,   643,   645,   647,   648,   652,   654,
+     658,   660,   662,   665,   668,   672,   674,   676,   678,   680,
+     682,   686,   690,   694,   699,   704,   708,   713,   718,   722,
+     727,   732,   737,   742,   747,   752,   757,   762,   767,   772,
+     777,   782,   787,   791,   796,   800,   805,   810,   812,   816,
+     818,   820,   822,   825,   828,   831,   833,   835,   838,   841,
+     844,   847,   850,   853,   856,   859,   862,   866,   870,   873,
+     876,   879,   882,   885,   888,   891,   894,   897,   900,   901,
+     903,   906,   909,   912,   914,   916,   918,   920,   921,   923,
+     926,   931,   937,   942,   947,   951,   953,   956,   958,   962,
+     964,   966,   970,   976,   981,   985,   988,   991,   993,   995,
+     997,   999,  1001,  1003,  1005,  1007,  1010,  1013,  1015,  1018,
+    1020,  1022,  1023,  1025,  1031,  1032,  1034,  1036,  1038,  1039,
+    1042,  1045,  1051,  1054,  1059,  1066,  1073,  1075,  1077,  1081,
+    1085,  1087,  1091,  1095,  1097,  1099,  1101,  1103,  1105,  1107,
+    1109,  1111,  1113,  1116,  1118,  1120,  1123,  1126,  1129,  1133,
+    1136,  1142,  1148,  1151,  1154,  1157,  1160,  1162,  1167,  1169,
+    1172,  1175,  1178,  1181,  1183,  1185,  1187,  1189,  1195,  1202,
+    1203,  1207,  1208,  1213,  1214,  1219,  1224,  1226,  1228,  1230,
+    1232,  1234,  1238,  1243,  1245,  1248,  1250,  1253,  1254,  1255,
+    1258,  1262,  1264,  1269,  1271,  1273,  1278,  1281,  1287,  1291,
+    1295,  1297,  1302,  1305,  1312,  1321,  1327,  1331,  1333,  1335,
+    1337,  1339,  1341,  1344,  1351,  1352,  1354,  1357,  1361,  1362,
+    1364,  1367,  1371,  1379,  1385,  1391,  1398,  1400,  1403,  1405,
+    1408,  1414,  1419,  1420,  1422,  1425,  1429,  1436,  1441,  1444,
+    1448,  1450,  1453,  1457,  1459,  1461,  1465,  1467,  1470,  1473,
+    1477,  1479,  1481,  1483,  1485,  1487,  1489,  1491,  1493,  1495,
+    1496,  1501,  1509,  1511,  1515,  1518,  1521,  1524,  1525,  1529,
+    1530,  1532,  1535,  1538,  1540,  1542,  1546,  1548,  1551,  1553,
+    1555,  1556,  1558,  1561,  1564,  1565,  1568,  1572,  1576,  1580,
+    1582,  1586,  1588,  1590,  1594,  1596,  1598,  1600,  1604,  1610,
+    1615,  1618,  1621,  1622,  1624,  1626,  1628,  1630,  1632,  1634,
+    1636,  1638,  1640,  1644,  1646,  1648,  1652,  1656,  1660,  1664,
+    1667,  1671,  1674,  1677,  1680,  1683,  1686,  1689,  1692,  1696,
+    1698,  1700,  1702,  1704,  1708,  1711,  1716,  1719,  1722,  1728,
+    1729,  1731,  1734,  1736,  1738,  1740,  1742,  1746,  1750,  1754,
+    1758,  1762,  1766,  1772,  1778,  1784,  1790,  1798,  1807,  1810,
+    1812,  1816,  1818,  1820,  1824,  1825,  1830,  1832
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int16 yyrhs[] =
+{
+     170,     0,    -1,    -1,   170,   171,    -1,   172,    -1,   173,
+      -1,   140,   173,    -1,     1,    -1,   166,   175,    -1,    24,
+      -1,   172,   166,   175,    -1,   172,    24,    -1,   172,   140,
+      -1,   174,    -1,   173,    24,   166,    -1,   173,    24,   174,
+      -1,   178,   175,    -1,   186,   175,    -1,    28,   181,   175,
+      -1,   282,    -1,    -1,    -1,    70,    -1,    -1,    26,   183,
+      -1,   176,    29,   180,   182,    -1,    30,   180,    -1,   176,
+      31,   180,   182,   177,    -1,    92,   160,    -1,   161,    -1,
+     179,   161,    -1,   160,    -1,   153,    -1,    -1,   162,   163,
+      -1,   162,   184,   163,    -1,    -1,   162,   163,    -1,   162,
+     184,   163,    -1,   185,    -1,   184,     3,   185,    -1,   160,
+      -1,    21,    -1,   228,   196,    -1,   141,   187,   195,   336,
+      -1,   143,   336,    -1,   114,   190,    -1,   198,   162,   221,
+     163,    -1,   198,   221,    -1,   215,    -1,   203,    -1,   225,
+      -1,   211,    -1,   213,    -1,   212,    -1,   276,    -1,   223,
+      -1,   209,    -1,    66,   162,   249,   163,    -1,   108,   195,
+     214,    -1,   110,   195,   189,    -1,    65,   191,    -1,   199,
+     166,    -1,    -1,   244,    -1,    42,    -1,    34,    -1,    39,
+      -1,    54,    -1,    77,    -1,    40,    -1,    43,    -1,    60,
+      -1,    55,    -1,    56,    -1,    57,    -1,    58,    -1,    59,
+      -1,    62,    -1,    63,    -1,    64,    -1,    67,    -1,    68,
+      -1,    69,    -1,    72,    -1,    73,    -1,    74,    -1,    75,
+      -1,   160,    -1,   188,    -1,   189,     3,   188,    -1,   162,
+     194,   163,    -1,   190,     3,   162,   194,   163,    -1,   192,
+      -1,   191,     3,   192,    -1,   162,   193,   163,    -1,   267,
+     245,    -1,   193,     3,   267,   245,    -1,   249,    -1,   194,
+       3,   249,    -1,    -1,   131,    -1,   226,   227,    -1,   197,
+     180,   182,    -1,    31,    -1,    25,    -1,   155,   200,    -1,
+     201,    -1,   200,   220,   201,    -1,   160,    22,   202,    22,
+      -1,   206,    22,   202,    22,    -1,   162,   257,     3,   368,
+     163,    22,   202,    22,    -1,   207,    -1,   207,     3,   202,
+      -1,   204,   205,    -1,   204,   219,   205,    -1,   203,   220,
+     219,   220,   205,    -1,   203,     3,   205,    -1,   116,    -1,
+      -1,   160,   245,    -1,   160,    -1,   160,   162,   249,   163,
+      -1,   206,     3,   206,    -1,   208,   268,    -1,   207,    19,
+     207,    -1,   207,    20,   207,    -1,   207,    21,   207,    -1,
+     207,   167,   207,    -1,    -1,   253,    -1,   111,   267,    -1,
+     111,   219,   267,    -1,   209,   220,   219,   220,   267,    -1,
+     209,     3,   267,    -1,   106,    -1,   210,   220,   160,   245,
+     233,    -1,   211,     3,   160,   245,   233,    -1,    79,   166,
+      -1,    79,   195,   214,    -1,    78,   166,    -1,    78,   195,
+     214,    -1,   160,    -1,   133,    -1,   214,     3,   160,    -1,
+     214,     3,   133,    -1,   216,   217,    -1,   216,   219,   217,
+      -1,   215,   220,   219,   220,   217,    -1,   123,    -1,   124,
+     123,    -1,   218,    -1,   217,     3,   218,    -1,   160,   245,
+      -1,    18,    -1,    22,   160,    22,    -1,    -1,     3,    -1,
+     222,    -1,   221,     3,   222,    -1,   160,     5,   249,    -1,
+     128,   224,    -1,   160,    -1,   224,     3,   160,    -1,   118,
+     119,    -1,   118,   130,    -1,   240,   160,   245,   233,   274,
+      -1,   226,     3,   160,   245,   233,   274,    -1,    -1,   232,
+     235,    -1,   231,   229,    -1,   232,    21,   161,    -1,   142,
+     237,   163,    -1,    -1,    21,   161,    -1,    21,   162,   230,
+     163,    -1,   162,   230,   163,    -1,   160,   238,   239,    -1,
+     160,     5,   238,   239,    -1,   238,   239,    -1,   152,    -1,
+     145,    -1,   146,    -1,   144,    -1,   158,    -1,   159,    -1,
+     147,    -1,    -1,    21,   234,    -1,   249,    -1,   162,    21,
+     163,    -1,    -1,    21,   236,    -1,   162,   237,   163,    -1,
+     249,    -1,   162,    21,   163,    -1,   160,   238,    -1,   160,
+       5,   238,    -1,   160,    -1,   161,    -1,   133,    -1,   249,
+      -1,    21,    -1,    -1,     3,   160,   238,    -1,    -1,   131,
+      -1,     3,   241,   131,    -1,   242,    -1,   241,     3,   242,
+      -1,    25,    -1,   244,    -1,    80,    -1,   106,   245,    -1,
+     108,    -1,   109,   162,   243,   163,    -1,   110,    -1,   113,
+      -1,   114,    -1,   116,    -1,   117,    -1,   136,    -1,   134,
+      -1,   135,    -1,    78,    -1,    79,    -1,    -1,   162,   246,
+     163,    -1,   247,    -1,   246,     3,   247,    -1,   248,    -1,
+       4,    -1,   249,     4,    -1,     4,   249,    -1,   249,     4,
+     248,    -1,    21,    -1,   249,    -1,   252,    -1,   275,    -1,
+     250,    -1,   162,   249,   163,    -1,    42,   251,   163,    -1,
+      33,   251,   163,    -1,    34,   162,   251,   163,    -1,    39,
+     162,   251,   163,    -1,    54,   251,   163,    -1,    77,   162,
+     251,   163,    -1,    40,   162,   249,   163,    -1,    43,   249,
+     163,    -1,   144,   162,   251,   163,    -1,    60,   162,   249,
+     163,    -1,    55,   162,   249,   163,    -1,    56,   162,   249,
+     163,    -1,    57,   162,   249,   163,    -1,    58,   162,   249,
+     163,    -1,    59,   162,   249,   163,    -1,    62,   162,   249,
+     163,    -1,    63,   162,   249,   163,    -1,    64,   162,   249,
+     163,    -1,    67,   162,   249,   163,    -1,    68,   162,   249,
+     163,    -1,    69,   162,   249,   163,    -1,    71,   249,   163,
+      -1,    72,   162,   251,   163,    -1,    73,   251,   163,    -1,
+      74,   162,   251,   163,    -1,    75,   162,   251,   163,    -1,
+     249,    -1,   251,     3,   249,    -1,   257,    -1,   268,    -1,
+     262,    -1,   249,   254,    -1,   253,   249,    -1,    11,   249,
+      -1,    19,    -1,    20,    -1,    19,   249,    -1,    20,   249,
+      -1,    21,   249,    -1,    23,   249,    -1,    13,   249,    -1,
+       7,   249,    -1,    16,   249,    -1,   165,   249,    -1,   164,
+     249,    -1,   165,     5,   249,    -1,   164,     5,   249,    -1,
+      17,   249,    -1,    14,   249,    -1,    15,   249,    -1,    12,
+     249,    -1,     6,   249,    -1,     8,   249,    -1,     9,   249,
+      -1,    10,   249,    -1,    22,   255,    -1,     5,   256,    -1,
+      -1,   249,    -1,     5,   249,    -1,    22,   249,    -1,     5,
+     249,    -1,   249,    -1,   267,    -1,   261,    -1,   259,    -1,
+      -1,   260,    -1,   260,   271,    -1,   261,   162,   263,   163,
+      -1,   261,   162,   263,   163,   271,    -1,   267,   162,   263,
+     163,    -1,   257,   168,   356,   257,    -1,   125,   366,   126,
+      -1,   258,    -1,   258,   264,    -1,   265,    -1,   264,     3,
+     265,    -1,   249,    -1,   266,    -1,   249,     4,   249,    -1,
+     249,     4,   249,     4,   249,    -1,     4,   249,     4,   249,
+      -1,     4,     4,   249,    -1,     4,   249,    -1,   249,     4,
+      -1,     4,    -1,   160,    -1,   138,    -1,   139,    -1,    41,
+      -1,   161,    -1,   157,    -1,   132,    -1,   268,   160,    -1,
+     269,   270,    -1,   153,    -1,   269,   153,    -1,   156,    -1,
+     154,    -1,    -1,   271,    -1,   162,   272,     4,   272,   163,
+      -1,    -1,   249,    -1,   166,    -1,   249,    -1,    -1,     5,
+     249,    -1,   122,   249,    -1,   162,   252,     3,   252,   163,
+      -1,   277,   160,    -1,   277,   160,     3,   278,    -1,   277,
+     160,     3,    27,     4,   166,    -1,   277,   160,     3,    27,
+       4,   280,    -1,   137,    -1,   279,    -1,   278,     3,   279,
+      -1,   160,   122,   160,    -1,   281,    -1,   280,     3,   281,
+      -1,   160,   122,   160,    -1,   160,    -1,   283,    -1,   331,
+      -1,   284,    -1,   300,    -1,   320,    -1,   310,    -1,   287,
+      -1,   115,    -1,   338,   340,    -1,   369,    -1,   341,    -1,
+     357,   352,    -1,   359,   350,    -1,   100,   352,    -1,   100,
+     352,   366,    -1,   103,   353,    -1,    96,   162,   370,   373,
+     163,    -1,   104,   162,   372,   373,   163,    -1,    76,   272,
+      -1,    81,   273,    -1,    61,   273,    -1,   348,   273,    -1,
+     339,    -1,   105,   162,   374,   163,    -1,   333,    -1,   334,
+     336,    -1,   332,   336,    -1,   335,   336,    -1,    93,   336,
+      -1,   319,    -1,   286,    -1,    90,    -1,   249,    -1,    35,
+     162,   294,   163,   293,    -1,   291,   172,   288,   289,   290,
+     297,    -1,    -1,   288,   292,   172,    -1,    -1,   289,   295,
+     172,   288,    -1,    -1,   290,   296,   172,   288,    -1,    35,
+     162,   294,   163,    -1,   293,    -1,   286,    -1,   287,    -1,
+     285,    -1,   249,    -1,    36,   294,   163,    -1,    36,   294,
+     163,   160,    -1,    37,    -1,    37,   160,    -1,    38,    -1,
+      38,   160,    -1,    -1,    -1,   299,   282,    -1,   299,   282,
+     172,    -1,   301,    -1,   302,   172,   307,   308,    -1,   303,
+      -1,   304,    -1,   160,     4,    89,   179,    -1,    89,   179,
+      -1,   160,     4,    89,   179,   305,    -1,    89,   179,   305,
+      -1,   160,     4,    89,    -1,    89,    -1,   160,     4,    89,
+     305,    -1,    89,   305,    -1,   220,   306,     5,   249,     3,
+     249,    -1,   220,   306,     5,   249,     3,   249,     3,   249,
+      -1,   220,    94,   162,   249,   163,    -1,   220,    95,   298,
+      -1,   267,    -1,   299,    -1,   309,    -1,   330,    -1,    91,
+      -1,    91,   160,    -1,   315,   172,   299,   311,   313,   318,
+      -1,    -1,   312,    -1,   311,   312,    -1,   316,   172,   299,
+      -1,    -1,   314,    -1,   313,   312,    -1,   317,   172,   299,
+      -1,   160,     4,    88,   162,   249,   163,    82,    -1,    88,
+     162,   249,   163,    82,    -1,    83,   162,   249,   163,    82,
+      -1,    83,   162,   249,   163,    82,   160,    -1,    84,    -1,
+      84,   160,    -1,    85,    -1,    85,   160,    -1,    88,   162,
+     249,   163,   284,    -1,   323,   172,   321,   325,    -1,    -1,
+     322,    -1,   321,   322,    -1,   324,   172,   299,    -1,   160,
+       4,    45,   162,   249,   163,    -1,    45,   162,   249,   163,
+      -1,    44,   326,    -1,    44,   326,   160,    -1,   107,    -1,
+     107,   160,    -1,   162,   327,   163,    -1,   112,    -1,   328,
+      -1,   327,     3,   328,    -1,   329,    -1,   329,     4,    -1,
+       4,   329,    -1,   329,     4,   329,    -1,   249,    -1,   115,
+      -1,    32,    -1,   148,    -1,   151,    -1,   150,    -1,   149,
+      -1,   166,    -1,   160,    -1,    -1,   267,   337,   245,   245,
+      -1,   338,   168,   356,   267,   337,   245,   245,    -1,   161,
+      -1,   339,     3,   161,    -1,     5,   249,    -1,   122,   249,
+      -1,   344,   342,    -1,    -1,   162,   343,   163,    -1,    -1,
+     346,    -1,   345,   101,    -1,   345,   160,    -1,   120,    -1,
+     347,    -1,   346,     3,   347,    -1,   249,    -1,    21,   161,
+      -1,   127,    -1,   129,    -1,    -1,   363,    -1,   352,   349,
+      -1,   358,   351,    -1,    -1,     3,   363,    -1,   162,   354,
+     163,    -1,   162,   267,   163,    -1,   162,   161,   163,    -1,
+     161,    -1,   162,   252,   163,    -1,   160,    -1,   355,    -1,
+     354,     3,   355,    -1,   360,    -1,    21,    -1,    23,    -1,
+     267,   249,   245,    -1,   267,   249,   168,   356,   338,    -1,
+     267,   162,   266,   163,    -1,   267,    21,    -1,   267,    23,
+      -1,    -1,    97,    -1,    98,    -1,   101,    -1,   361,    -1,
+      21,    -1,   102,    -1,    99,    -1,    86,    -1,   361,    -1,
+     162,   360,   163,    -1,   257,    -1,   268,    -1,   360,   362,
+     360,    -1,   360,    21,   360,    -1,   360,    22,   360,    -1,
+     360,    23,   360,    -1,   362,   360,    -1,   360,    18,   360,
+      -1,    46,   249,    -1,    47,   249,    -1,    49,   249,    -1,
+      48,   249,    -1,    53,   249,    -1,    52,   249,    -1,    50,
+     249,    -1,   160,     5,   249,    -1,   250,    -1,    19,    -1,
+      20,    -1,   364,    -1,   363,     3,   364,    -1,   257,   365,
+      -1,   162,   363,   163,   365,    -1,   250,   365,    -1,   268,
+     365,    -1,   162,   363,     3,   368,   163,    -1,    -1,   254,
+      -1,   365,   254,    -1,   275,    -1,   250,    -1,   252,    -1,
+     367,    -1,   252,     3,   249,    -1,   252,     3,   367,    -1,
+     367,     3,   249,    -1,   367,     3,   367,    -1,   366,     3,
+     249,    -1,   366,     3,   367,    -1,   162,   252,     3,   368,
+     163,    -1,   162,   366,     3,   368,   163,    -1,   162,   367,
+       3,   368,   163,    -1,   160,     5,   249,     3,   249,    -1,
+     160,     5,   249,     3,   249,     3,   249,    -1,    87,   162,
+     249,     3,   249,   163,     3,   249,    -1,    87,   161,    -1,
+     371,    -1,   370,     3,   371,    -1,   257,    -1,   371,    -1,
+     372,     3,   371,    -1,    -1,     3,   121,     5,   257,    -1,
+     267,    -1,   374,     3,   267,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint16 yyrline[] =
+{
+       0,   313,   313,   314,   316,   317,   318,   319,   322,   323,
+     324,   325,   326,   329,   330,   331,   334,   335,   336,   344,
+     347,   350,   351,   354,   355,   358,   366,   375,   392,   411,
+     412,   415,   417,   419,   420,   421,   423,   424,   425,   427,
+     439,   451,   452,   454,   455,   456,   457,   458,   475,   492,
+     493,   498,   499,   536,   549,   550,   551,   552,   553,   554,
+     555,   556,   557,   570,   571,   578,   579,   580,   581,   582,
+     583,   584,   585,   586,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   599,   600,   601,   604,
+     605,   608,   609,   612,   613,   615,   618,   619,   622,   623,
+     625,   626,   629,   695,   710,   712,   716,   719,   720,   723,
+     729,   734,   748,   749,   752,   753,   754,   755,   758,   760,
+     761,   764,   765,   766,   769,   770,   771,   772,   773,   775,
+     776,   779,   780,   781,   782,   785,   792,   802,   814,   815,
+     818,   819,   822,   823,   824,   825,   828,   834,   842,   852,
+     853,   856,   857,   860,   868,   874,   881,   882,   885,   886,
+     889,   905,   908,   909,   912,   921,   923,   945,   970,   972,
+     973,   974,   975,   977,   978,   979,   980,   983,   984,   985,
+     987,   990,   991,   992,   993,   994,   995,   997,   998,  1001,
+    1002,  1004,  1005,  1006,  1008,  1009,  1012,  1013,  1023,  1024,
+    1025,  1028,  1029,  1031,  1032,  1034,  1035,  1036,  1038,  1039,
+    1042,  1043,  1044,  1045,  1046,  1047,  1049,  1050,  1051,  1052,
+    1053,  1056,  1057,  1058,  1061,  1062,  1064,  1065,  1073,  1079,
+    1086,  1087,  1088,  1089,  1090,  1093,  1094,  1096,  1097,  1098,
+    1099,  1103,  1104,  1105,  1106,  1107,  1108,  1109,  1110,  1111,
+    1112,  1113,  1114,  1115,  1116,  1117,  1118,  1119,  1120,  1121,
+    1122,  1123,  1124,  1125,  1126,  1127,  1128,  1130,  1131,  1133,
+    1134,  1135,  1136,  1137,  1138,  1140,  1141,  1145,  1146,  1147,
+    1148,  1149,  1150,  1151,  1152,  1153,  1154,  1155,  1156,  1157,
+    1158,  1159,  1160,  1161,  1162,  1163,  1164,  1165,  1167,  1168,
+    1169,  1170,  1173,  1174,  1177,  1178,  1179,  1183,  1194,  1195,
+    1196,  1197,  1200,  1209,  1216,  1219,  1220,  1223,  1224,  1227,
+    1228,  1231,  1232,  1233,  1234,  1235,  1236,  1237,  1239,  1285,
+    1286,  1287,  1288,  1289,  1290,  1291,  1293,  1296,  1297,  1298,
+    1299,  1301,  1302,  1305,  1307,  1308,  1311,  1312,  1314,  1315,
+    1321,  1329,  1332,  1352,  1379,  1399,  1439,  1446,  1450,  1457,
+    1467,  1468,  1476,  1486,  1498,  1499,  1504,  1505,  1506,  1507,
+    1508,  1513,  1514,  1515,  1516,  1517,  1518,  1519,  1520,  1521,
+    1522,  1523,  1524,  1525,  1526,  1527,  1528,  1529,  1530,  1567,
+    1576,  1587,  1595,  1617,  1618,  1619,  1657,  1661,  1665,  1668,
+    1669,  1672,  1673,  1676,  1677,  1682,  1686,  1687,  1688,  1692,
+    1696,  1701,  1702,  1707,  1708,  1713,  1714,  1718,  1722,  1723,
+    1724,  1729,  1734,  1739,  1740,  1745,  1746,  1747,  1748,  1753,
+    1754,  1755,  1756,  1761,  1762,  1763,  1764,  1768,  1772,  1776,
+    1777,  1782,  1783,  1787,  1790,  1791,  1792,  1796,  1799,  1800,
+    1801,  1804,  1809,  1810,  1815,  1816,  1821,  1822,  1827,  1828,
+    1832,  1836,  1839,  1840,  1841,  1844,  1849,  1850,  1855,  1856,
+    1861,  1862,  1867,  1868,  1872,  1873,  1878,  1879,  1880,  1881,
+    1885,  1889,  1893,  1897,  1905,  1912,  1919,  1926,  1927,  1930,
+    1933,  1944,  1950,  1951,  1954,  1955,  1957,  1970,  1971,  1973,
+    1974,  1977,  1978,  2000,  2003,  2004,  2007,  2015,  2018,  2019,
+    2022,  2023,  2026,  2027,  2029,  2030,  2032,  2035,  2036,  2037,
+    2038,  2039,  2042,  2043,  2046,  2047,  2048,  2049,  2050,  2051,
+    2052,  2053,  2056,  2059,  2060,  2061,  2063,  2064,  2067,  2068,
+    2069,  2072,  2073,  2076,  2077,  2078,  2079,  2080,  2081,  2082,
+    2083,  2084,  2085,  2086,  2087,  2088,  2089,  2090,  2091,  2092,
+    2094,  2095,  2097,  2098,  2104,  2105,  2106,  2107,  2108,  2110,
+    2111,  2112,  2115,  2116,  2117,  2118,  2119,  2120,  2121,  2122,
+    2123,  2124,  2127,  2128,  2129,  2131,  2132,  2134,  2135,  2138,
+    2139,  2142,  2145,  2146,  2148,  2149,  2152,  2153
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || 0
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "','", "':'", "'='", "TOK_NEQV",
+  "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT", "TOK_NE", "TOK_EQ",
+  "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT", "TOK_DSLASH", "'+'", "'-'",
+  "'*'", "TOK_SLASH", "TOK_DASTER", "TOK_SEMICOLON", "TOK_PARAMETER",
+  "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE", "TOK_SUBROUTINE", "TOK_PROGRAM",
+  "TOK_FUNCTION", "TOK_FORMAT", "TOK_MAX", "TOK_TANH", "TOK_WHERE",
+  "TOK_ELSEWHEREPAR", "TOK_ELSEWHERE", "TOK_ENDWHERE", "TOK_MAXVAL",
+  "TOK_TRIM", "TOK_NULL_PTR", "TOK_SUM", "TOK_SQRT", "TOK_CASE",
+  "TOK_SELECTCASE", "TOK_FILE", "TOK_UNIT", "TOK_FMT", "TOK_NML",
+  "TOK_END", "TOK_EOR", "TOK_ERR", "TOK_EXIST", "TOK_MIN", "TOK_FLOAT",
+  "TOK_EXP", "TOK_COS", "TOK_COSH", "TOK_ACOS", "TOK_NINT", "TOK_CYCLE",
+  "TOK_SIN", "TOK_SINH", "TOK_ASIN", "TOK_EQUIVALENCE", "TOK_BACKSPACE",
+  "TOK_LOG", "TOK_TAN", "TOK_ATAN", "TOK_RECURSIVE", "TOK_ABS", "TOK_MOD",
+  "TOK_SIGN", "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT", "TOK_MINVAL",
+  "TOK_PUBLIC", "TOK_PRIVATE", "TOK_ALLOCATABLE", "TOK_RETURN", "TOK_THEN",
+  "TOK_ELSEIF", "TOK_ELSE", "TOK_ENDIF", "TOK_PRINT", "TOK_PLAINGOTO",
+  "TOK_LOGICALIF", "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO",
+  "TOK_MODULE", "TOK_ENDMODULE", "TOK_WHILE", "TOK_CONCURRENT",
+  "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE", "TOK_INQUIRE", "TOK_WRITE",
+  "TOK_FLUSH", "TOK_READ", "TOK_REWIND", "TOK_DEALLOCATE", "TOK_NULLIFY",
+  "TOK_DIMENSION", "TOK_ENDSELECT", "TOK_EXTERNAL", "TOK_INTENT",
+  "TOK_INTRINSIC", "TOK_NAMELIST", "TOK_DEFAULT", "TOK_OPTIONAL",
+  "TOK_POINTER", "TOK_CONTINUE", "TOK_SAVE", "TOK_TARGET", "TOK_IMPLICIT",
+  "TOK_NONE", "TOK_CALL", "TOK_STAT", "TOK_POINT_TO", "TOK_COMMON",
+  "TOK_GLOBAL", "TOK_LEFTAB", "TOK_RIGHTAB", "TOK_PAUSE", "TOK_PROCEDURE",
+  "TOK_STOP", "TOK_REAL8", "TOK_FOURDOTS", "TOK_HEXA", "TOK_ASSIGNTYPE",
+  "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", "TOK_TRUE", "TOK_FALSE",
+  "TOK_LABEL", "TOK_TYPE", "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_REAL",
+  "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_ENDSUBROUTINE",
+  "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT", "TOK_CHARACTER",
+  "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA", "TOK_CHAR_MESSAGE",
+  "TOK_CSTREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX", "TOK_NAME",
+  "TOK_CSTINT", "'('", "')'", "'<'", "'>'", "'\\n'", "'/'", "'%'",
+  "$accept", "input", "line", "line-break", "suite_line_list",
+  "suite_line", "fin_line", "opt_recursive", "opt_result", "entry",
+  "label", "name_routine", "filename", "arglist", "arglist_after_result",
+  "args", "arg", "spec", "opt_spec", "name_intrinsic",
+  "use_intrinsic_list", "list_couple", "list_expr_equi", "expr_equi",
+  "list_expr_equi1", "list_expr", "opt_sep", "after_type",
+  "before_function", "before_parameter", "data_stmt", "data_stmt_set_list",
+  "data_stmt_set", "data_stmt_value_list", "save", "before_save",
+  "varsave", "datanamelist", "expr_data", "opt_signe", "namelist",
+  "before_dimension", "dimension", "private", "public", "use_name_list",
+  "common", "before_common", "var_common_list", "var_common", "comblock",
+  "opt_comma", "paramlist", "paramitem", "module_proc_stmt",
+  "proc_name_list", "implicit", "dcl", "nodimsgiven", "type", "c_selector",
+  "c_attribute", "before_character", "typespec", "lengspec",
+  "proper_lengspec", "selector", "proper_selector", "attribute", "clause",
+  "opt_clause", "options", "attr_spec_list", "attr_spec", "intent_spec",
+  "access_spec", "dims", "dimlist", "dim", "ubound", "expr",
+  "predefinedfunction", "minmaxlist", "uexpr", "signe", "operation",
+  "after_slash", "after_equal", "lhs", "beforefunctionuse",
+  "array_ele_substring_func_ref", "begin_array", "structure_component",
+  "vec", "funarglist", "funargs", "funarg", "triplet", "ident",
+  "simple_const", "string_constant", "opt_substring", "substring",
+  "optexpr", "opt_expr", "initial_value", "complex_const", "use_stat",
+  "word_use", "rename_list", "rename_name", "only_list", "only_name",
+  "execution-part-construct", "executable-construct", "action-stmt",
+  "assignment-stmt", "where-stmt", "where-construct",
+  "opt-where-body-construct", "opt-masked-elsewhere-construct",
+  "opt-elsewhere-construct", "where-construct-stmt",
+  "where-body-construct", "where-assignment-stmt", "mask-expr",
+  "masked-elsewhere-stmt", "elsewhere-stmt", "end-where-stmt",
+  "forall-header", "block", "do-construct", "block-do-construct",
+  "do-stmt", "label-do-stmt", "nonlabel-do-stmt", "loop-control",
+  "do-variable", "do-block", "end-do", "end-do-stmt", "if-construct",
+  "opt-else-if-stmt-block", "else-if-stmt-block", "opt-else-stmt-block",
+  "else-stmt-block", "if-then-stmt", "else-if-stmt", "else-stmt",
+  "end-if-stmt", "if-stmt", "case-construct", "opt_case-stmt-block",
+  "case-stmt-block", "select-case-stmt", "case-stmt", "end-select-stmt",
+  "case-selector", "case-value-range-list", "case-value-range",
+  "case-value", "continue-stmt", "format-stmt", "word_endsubroutine",
+  "word_endunit", "word_endprogram", "word_endfunction", "opt_name",
+  "before_dims", "ident_dims", "int_list", "after_ident_dims", "call",
+  "opt_call", "opt_callarglist", "keywordcall", "before_call",
+  "callarglist", "callarg", "stop", "option_inlist", "option_read",
+  "opt_inlist", "ioctl", "after_rewind", "ctllist", "ioclause",
+  "declare_after_percent", "iofctl", "infmt", "read", "fexpr",
+  "unpar_fexpr", "addop", "inlist", "inelt", "opt_operation", "outlist",
+  "other", "dospec", "goto", "allocation_list", "allocate_object",
+  "allocate_object_list", "opt_stat_spec", "pointer_name_list", YY_NULL
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,    44,    58,    61,   258,   259,   260,   261,
+     262,   263,   264,   265,   266,   267,   268,   269,   270,    43,
+      45,    42,   271,   272,   273,   274,   275,   276,   277,   278,
+     279,   280,   281,   282,   283,   284,   285,   286,   287,   288,
+     289,   290,   291,   292,   293,   294,   295,   296,   297,   298,
+     299,   300,   301,   302,   303,   304,   305,   306,   307,   308,
+     309,   310,   311,   312,   313,   314,   315,   316,   317,   318,
+     319,   320,   321,   322,   323,   324,   325,   326,   327,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   337,   338,
+     339,   340,   341,   342,   343,   344,   345,   346,   347,   348,
+     349,   350,   351,   352,   353,   354,   355,   356,   357,   358,
+     359,   360,   361,   362,   363,   364,   365,   366,   367,   368,
+     369,   370,   371,   372,   373,   374,   375,   376,   377,   378,
+     379,   380,   381,   382,   383,   384,   385,   386,   387,   388,
+     389,   390,   391,   392,   393,   394,   395,   396,   397,   398,
+     399,   400,   401,   402,   403,   404,   405,   406,   407,   408,
+     409,   410,    40,    41,    60,    62,    10,    47,    37
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint16 yyr1[] =
+{
+       0,   169,   170,   170,   171,   171,   171,   171,   172,   172,
+     172,   172,   172,   173,   173,   173,   174,   174,   174,   174,
+     175,   176,   176,   177,   177,   178,   178,   178,   178,   179,
+     179,   180,   181,   182,   182,   182,   183,   183,   183,   184,
+     184,   185,   185,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   186,   186,   186,   186,   186,   186,   186,
+     186,   186,   186,   187,   187,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   188,
+     188,   188,   188,   188,   188,   188,   188,   188,   188,   189,
+     189,   190,   190,   191,   191,   192,   193,   193,   194,   194,
+     195,   195,   196,   196,   197,   198,   199,   200,   200,   201,
+     201,   201,   202,   202,   203,   203,   203,   203,   204,   205,
+     205,   206,   206,   206,   207,   207,   207,   207,   207,   208,
+     208,   209,   209,   209,   209,   210,   211,   211,   212,   212,
+     213,   213,   214,   214,   214,   214,   215,   215,   215,   216,
+     216,   217,   217,   218,   219,   219,   220,   220,   221,   221,
+     222,   223,   224,   224,   225,   225,   226,   226,   227,   228,
+     228,   228,   228,   229,   229,   229,   229,   230,   230,   230,
+     231,   232,   232,   232,   232,   232,   232,   233,   233,   234,
+     234,   235,   235,   235,   236,   236,   237,   237,   237,   237,
+     237,   238,   238,   239,   239,   240,   240,   240,   241,   241,
+     242,   242,   242,   242,   242,   242,   242,   242,   242,   242,
+     242,   243,   243,   243,   244,   244,   245,   245,   246,   246,
+     247,   247,   247,   247,   247,   248,   248,   249,   249,   249,
+     249,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   250,   250,   250,
+     250,   250,   250,   250,   250,   250,   250,   251,   251,   252,
+     252,   252,   252,   252,   252,   253,   253,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   254,   254,
+     254,   254,   254,   254,   254,   254,   254,   254,   255,   255,
+     255,   255,   256,   256,   257,   257,   257,   258,   259,   259,
+     259,   259,   260,   261,   262,   263,   263,   264,   264,   265,
+     265,   266,   266,   266,   266,   266,   266,   266,   267,   268,
+     268,   268,   268,   268,   268,   268,   268,   269,   269,   269,
+     269,   270,   270,   271,   272,   272,   273,   273,   274,   274,
+     274,   275,   276,   276,   276,   276,   277,   278,   278,   279,
+     280,   280,   281,   281,   282,   282,   283,   283,   283,   283,
+     283,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   284,   284,   284,   284,
+     284,   284,   284,   284,   284,   284,   285,   286,   287,   288,
+     288,   289,   289,   290,   290,   291,   292,   292,   292,   293,
+     294,   295,   295,   296,   296,   297,   297,   298,   299,   299,
+     299,   300,   301,   302,   302,   303,   303,   303,   303,   304,
+     304,   304,   304,   305,   305,   305,   305,   306,   307,   308,
+     308,   309,   309,   310,   311,   311,   311,   312,   313,   313,
+     313,   314,   315,   315,   316,   316,   317,   317,   318,   318,
+     319,   320,   321,   321,   321,   322,   323,   323,   324,   324,
+     325,   325,   326,   326,   327,   327,   328,   328,   328,   328,
+     329,   330,   331,   332,   333,   334,   335,   336,   336,   337,
+     338,   338,   339,   339,   340,   340,   341,   342,   342,   343,
+     343,   344,   344,   345,   346,   346,   347,   347,   348,   348,
+     349,   349,   350,   350,   351,   351,   352,   353,   353,   353,
+     353,   353,   354,   354,   355,   355,   355,   355,   355,   355,
+     355,   355,   356,   357,   357,   357,   358,   358,   359,   359,
+     359,   360,   360,   361,   361,   361,   361,   361,   361,   361,
+     361,   361,   361,   361,   361,   361,   361,   361,   361,   361,
+     362,   362,   363,   363,   364,   364,   364,   364,   364,   365,
+     365,   365,   366,   366,   366,   366,   366,   366,   366,   366,
+     366,   366,   367,   367,   367,   368,   368,   369,   369,   370,
+     370,   371,   372,   372,   373,   373,   374,   374
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     1,     1,     2,     1,     2,     1,
+       3,     2,     2,     1,     3,     3,     2,     2,     3,     1,
+       0,     0,     1,     0,     2,     4,     2,     5,     2,     1,
+       2,     1,     1,     0,     2,     3,     0,     2,     3,     1,
+       3,     1,     1,     2,     4,     2,     2,     4,     2,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     4,     3,
+       3,     2,     2,     0,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     1,
+       3,     3,     5,     1,     3,     3,     2,     4,     1,     3,
+       0,     1,     2,     3,     1,     1,     2,     1,     3,     4,
+       4,     8,     1,     3,     2,     3,     5,     3,     1,     0,
+       2,     1,     4,     3,     2,     3,     3,     3,     3,     0,
+       1,     2,     3,     5,     3,     1,     5,     5,     2,     3,
+       2,     3,     1,     1,     3,     3,     2,     3,     5,     1,
+       2,     1,     3,     2,     1,     3,     0,     1,     1,     3,
+       3,     2,     1,     3,     2,     2,     5,     6,     0,     2,
+       2,     3,     3,     0,     2,     4,     3,     3,     4,     2,
+       1,     1,     1,     1,     1,     1,     1,     0,     2,     1,
+       3,     0,     2,     3,     1,     3,     2,     3,     1,     1,
+       1,     1,     1,     0,     3,     0,     1,     3,     1,     3,
+       1,     1,     1,     2,     1,     4,     1,     1,     1,     1,
+       1,     1,     1,     1,     1,     1,     0,     3,     1,     3,
+       1,     1,     2,     2,     3,     1,     1,     1,     1,     1,
+       3,     3,     3,     4,     4,     3,     4,     4,     3,     4,
+       4,     4,     4,     4,     4,     4,     4,     4,     4,     4,
+       4,     4,     3,     4,     3,     4,     4,     1,     3,     1,
+       1,     1,     2,     2,     2,     1,     1,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     3,     3,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     0,     1,
+       2,     2,     2,     1,     1,     1,     1,     0,     1,     2,
+       4,     5,     4,     4,     3,     1,     2,     1,     3,     1,
+       1,     3,     5,     4,     3,     2,     2,     1,     1,     1,
+       1,     1,     1,     1,     1,     2,     2,     1,     2,     1,
+       1,     0,     1,     5,     0,     1,     1,     1,     0,     2,
+       2,     5,     2,     4,     6,     6,     1,     1,     3,     3,
+       1,     3,     3,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     2,     1,     1,     2,     2,     2,     3,     2,
+       5,     5,     2,     2,     2,     2,     1,     4,     1,     2,
+       2,     2,     2,     1,     1,     1,     1,     5,     6,     0,
+       3,     0,     4,     0,     4,     4,     1,     1,     1,     1,
+       1,     3,     4,     1,     2,     1,     2,     0,     0,     2,
+       3,     1,     4,     1,     1,     4,     2,     5,     3,     3,
+       1,     4,     2,     6,     8,     5,     3,     1,     1,     1,
+       1,     1,     2,     6,     0,     1,     2,     3,     0,     1,
+       2,     3,     7,     5,     5,     6,     1,     2,     1,     2,
+       5,     4,     0,     1,     2,     3,     6,     4,     2,     3,
+       1,     2,     3,     1,     1,     3,     1,     2,     2,     3,
+       1,     1,     1,     1,     1,     1,     1,     1,     1,     0,
+       4,     7,     1,     3,     2,     2,     2,     0,     3,     0,
+       1,     2,     2,     1,     1,     3,     1,     2,     1,     1,
+       0,     1,     2,     2,     0,     2,     3,     3,     3,     1,
+       3,     1,     1,     3,     1,     1,     1,     3,     5,     4,
+       2,     2,     0,     1,     1,     1,     1,     1,     1,     1,
+       1,     1,     3,     1,     1,     3,     3,     3,     3,     2,
+       3,     2,     2,     2,     2,     2,     2,     2,     3,     1,
+       1,     1,     1,     3,     2,     4,     2,     2,     5,     0,
+       1,     2,     1,     1,     1,     1,     3,     3,     3,     3,
+       3,     3,     5,     5,     5,     5,     7,     8,     2,     1,
+       3,     1,     1,     3,     0,     4,     1,     3
+};
+
+/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM.
+   Performed when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint16 yydefact[] =
+{
+       2,     0,     1,     7,     9,   105,     0,     0,   482,     0,
+       0,     0,     0,     0,    22,   344,   100,   100,     0,   540,
+       0,     0,   156,   395,     0,     0,     0,   533,   534,   539,
+       0,   535,   538,     0,     0,     0,   135,   100,   100,     0,
+       0,   371,   118,     0,   503,   149,     0,   508,     0,   509,
+     356,    21,    63,     0,     0,   183,   181,   182,   186,   483,
+     486,   485,   484,   180,     0,   184,   185,   328,   492,    20,
+       3,     4,     5,    13,     0,    20,    20,     0,     0,    50,
+     119,    57,   156,    52,    54,    53,    49,     0,    56,    51,
+     205,   173,   191,   489,    55,     0,    19,   364,   366,   394,
+     370,     0,   367,   421,     0,   423,   424,   369,     0,   393,
+     368,     0,   365,     0,   388,     0,     0,     0,   386,   374,
+     497,     0,     0,     0,     0,   373,    32,    20,    31,    26,
+       0,     0,     0,   275,   276,     0,     0,     0,     0,   331,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   334,   329,   330,     0,   337,   340,   339,   333,
+     328,   332,     0,   346,   347,   239,   237,     0,   269,   306,
+     308,   305,   271,   304,   270,   341,   384,   238,     0,    61,
+      93,     0,   345,   382,   101,   140,     0,   138,     0,   383,
+     588,     0,     0,   157,    29,   156,     0,   432,    28,   488,
+     487,   392,     0,     0,   377,   521,   519,     0,   379,     0,
+       0,     0,     0,   154,     0,     0,   131,     0,    46,   164,
+     165,   150,   162,   161,     6,   224,   225,   100,    64,   200,
+     198,   199,     0,    45,   121,     0,   156,   107,     0,     0,
+       8,    11,    12,    20,    21,     0,     0,    16,    17,     0,
+       0,    48,   158,    62,   119,     0,   226,   114,   119,   157,
+       0,     0,     0,     0,   226,   146,   151,     0,     0,   104,
+     206,    43,     0,   168,     0,     0,     0,   170,     0,     0,
+     169,   226,   352,   399,   418,   418,   462,   390,   389,   391,
+       0,     0,   532,   372,     0,   499,   496,   501,   502,   385,
+     375,   560,   561,   537,     0,     0,     0,     0,     0,     0,
+       0,   328,     0,   559,   543,   544,   376,   510,   514,     0,
+     536,     0,    18,   410,     0,     0,   274,   267,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   573,   574,   572,     0,   575,
+       0,     0,   237,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   298,     0,
+       0,     0,   272,   273,   532,   344,   309,   307,   307,   335,
+     338,   336,   342,     0,   226,     0,     0,   143,   142,   141,
+     139,     0,     0,    30,   428,     0,   417,   437,     0,   591,
+     594,   589,   525,   526,     0,   304,     0,   522,   524,   541,
+     378,   332,   237,   304,   592,   594,   596,     0,    59,    66,
+      67,    70,    65,    71,    68,    73,    74,    75,    76,    77,
+      72,    78,    79,    80,    81,    82,    83,    84,    85,    86,
+      87,    69,    88,    89,    60,     0,   132,     0,    98,     0,
+       0,     0,     0,   202,   196,   201,   172,   129,     0,     0,
+       0,     0,   129,     0,     0,   156,    10,    14,    15,    33,
+      33,     0,     0,     0,   117,   156,     0,   120,   115,   134,
+     156,   226,   226,   156,   153,     0,   147,   210,   212,   226,
+     214,     0,   216,   217,   218,   219,   220,     0,   208,   211,
+      33,     0,   102,   226,   174,     0,   328,     0,   203,   332,
+       0,   192,   194,     0,   226,     0,   401,   438,     0,   444,
+       0,     0,   463,     0,   494,   495,     0,   493,     0,   506,
+       0,   500,   504,   551,   552,   554,   553,   557,   556,   555,
+       0,   524,     0,   569,   569,   569,   512,   511,   562,     0,
+     513,     0,     0,     0,     0,     0,   549,   405,   467,     0,
+     242,     0,     0,     0,   241,   248,   245,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   262,
+       0,   264,     0,     0,     0,   237,     0,     0,     0,     0,
+     314,     0,     0,   240,     0,     0,   303,   297,   292,   282,
+     293,   294,   295,   291,   281,   289,   290,   283,   288,   277,
+     278,   279,     0,     0,   299,   296,   280,     0,   285,     0,
+     284,     0,     0,   315,     0,     0,     0,    95,    96,    94,
+      58,     0,     0,     0,     0,   436,     0,     0,     0,     0,
+     530,   531,   307,   226,     0,   516,   518,   520,   517,     0,
+       0,     0,   387,     0,   155,     0,    91,     0,   163,    44,
+     197,     0,   112,     0,   130,     0,     0,   108,   121,   123,
+       0,     0,     0,   156,   431,     0,    25,    23,   160,    47,
+     159,   119,   231,   235,     0,   228,   230,   236,     0,   187,
+     187,     0,   152,   213,     0,     0,   207,   103,   226,   187,
+       0,     0,   203,   176,     0,   179,     0,   193,   490,     0,
+       0,   353,   357,   396,   409,   407,   408,   403,     0,   406,
+     419,   441,   481,   422,   439,   440,     0,   448,   445,     0,
+     473,     0,   468,   470,   464,   461,   418,   489,   507,   498,
+       0,   558,   542,     0,   570,   566,   564,   567,     0,   515,
+     550,   546,   547,   548,   545,   397,   268,   243,   244,   247,
+     251,   252,   253,   254,   255,   250,   256,   257,   258,   259,
+     260,   261,   263,   265,   266,   246,     0,     0,     0,   576,
+     577,   580,   581,   578,   579,   249,   237,   302,   300,   301,
+     287,   286,   313,   344,   327,   319,   316,   317,   320,   310,
+     312,   226,   145,   144,     0,     0,   453,     0,   460,     0,
+       0,     0,   590,   380,     0,     0,   532,   527,   523,   593,
+     381,   597,    90,    99,     0,   109,   129,   129,   129,   129,
+     129,   124,   122,     0,     0,   110,     0,     0,   427,    42,
+      41,    34,     0,    39,    36,    27,   116,   233,     0,   227,
+     232,   133,     0,   136,   137,   148,   222,   223,   221,     0,
+     209,   187,   348,   175,   203,   177,     0,   195,     0,     0,
+       0,     0,     0,     0,   400,   420,   442,     0,   456,   446,
+       0,   449,     0,   418,     0,   480,     0,   474,   476,   469,
+     471,   465,   226,   505,     0,   569,   571,   563,   328,     0,
+       0,     0,   351,     0,     0,   325,   326,     0,   311,    97,
+       0,     0,     0,   435,     0,     0,   529,     0,    92,   113,
+     125,   126,   127,   128,     0,     0,   466,     0,     0,    35,
+       0,    24,   229,   234,   236,     0,   188,   189,   215,   348,
+       0,     0,   166,   178,   204,   363,   354,   355,   360,   359,
+     358,     0,   413,   415,     0,   398,   399,     0,   457,   458,
+     450,   443,   418,   447,   478,     0,   472,   477,   226,     0,
+     565,   582,   583,   584,   343,   324,     0,   321,   318,     0,
+       0,     0,   433,   595,   528,     0,   129,   452,    40,    37,
+       0,     0,   167,   349,   350,     0,     0,   411,   414,   416,
+     399,   402,     0,   459,   451,   475,   479,   491,   568,   323,
+       0,   587,     0,     0,     0,     0,     0,    38,   190,   362,
+     361,   412,   404,   454,   322,   434,   585,   111,   455,     0,
+     586
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int16 yydefgoto[] =
+{
+      -1,     1,    70,    71,    72,    73,   250,    74,   865,    75,
+     205,   129,   127,   696,   951,   862,   863,    76,   237,   463,
+     464,   228,   189,   190,   403,   467,   196,   281,   282,    77,
+      78,   246,   247,   681,    79,    80,   267,   248,   682,   683,
+      81,    82,    83,    84,    85,   409,    86,    87,   275,   276,
+     225,   206,   261,   262,    88,   233,    89,   283,   522,    90,
+     287,   527,    91,    92,   873,   956,   290,   531,   242,   528,
+     725,   284,   517,   518,   879,   519,   497,   704,   705,   706,
+     337,   175,   338,   176,   177,   392,   635,   617,   178,   643,
+     179,   180,   181,   182,   645,   816,   817,   818,   183,   184,
+     185,   401,   396,   193,   186,   962,   187,    94,    95,   731,
+     732,   967,   968,   740,    97,    98,   734,    99,   100,   536,
+     737,   892,   101,   738,   739,   334,   893,   974,   975,   655,
+     537,   102,   103,   104,   105,   106,   207,   418,   538,   743,
+     744,   107,   747,   748,   900,   901,   108,   749,   902,   981,
+     109,   110,   541,   542,   111,   543,   755,   752,   906,   907,
+     908,   745,   112,   113,   114,   115,   116,   211,   291,   117,
+     118,   303,   119,   306,   550,   120,   121,   551,   552,   122,
+     566,   326,   570,   214,   218,   426,   427,   546,   123,   328,
+     124,   428,   429,   331,   567,   568,   765,   368,   369,   854,
+     125,   420,   421,   435,   658,   437
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -845
+static const yytype_int16 yypact[] =
+{
+    -845,   967,  -845,  -845,  -845,  -845,   -22,    45,  -845,    94,
+     186,  3621,   199,   238,  -845,  4658,    16,    36,  3621,  -845,
+     369,   256,    56,  -845,   299,   280,   268,  -845,  -845,  -845,
+     306,  -845,  -845,   409,   311,   350,  -845,   357,   357,   119,
+     354,  -845,  -845,    53,  -845,  -845,   420,  -845,   386,  -845,
+    -845,  5758,   363,   274,   280,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   237,  -845,  -845,   549,  -845,  -845,
+    -845,   122,   563,  -845,   440,  -845,  -845,   319,   433,   436,
+     159,   495,   622,   624,  -845,  -845,   523,   329,  -845,  -845,
+     398,   102,   163,  -845,  -845,   471,  -845,  -845,  -845,  -845,
+    -845,   215,  -845,  -845,   215,  -845,  -845,  -845,   215,  -845,
+    -845,   215,  -845,   280,  -845,   280,   280,    20,   630,  -845,
+     472,    44,  3621,   306,  5477,  -845,  -845,  -845,  -845,  -845,
+    4658,  4658,  4658,  -845,  -845,  4658,   473,   474,   477,  -845,
+    4658,  4658,  4658,   478,   484,   486,   487,   488,   494,   496,
+     497,   498,   499,   500,   501,  4658,   505,  4658,   507,   508,
+     511,  4767,  -845,  -845,  -845,   512,  -845,  -845,  -845,  -845,
+    -845,  -845,  4658,  -845,  2490,  -845,  -845,  4658,   470,  -845,
+     513,   515,  -845,   516,   522,   270,  -845,  -845,   524,   654,
+    -845,  4658,  2490,  -845,  -845,  -845,   277,  -845,   277,  -845,
+    -845,  4658,  4658,  -845,  -845,   110,   326,  -845,  -845,  -845,
+    -845,  -845,   524,  5347,  4767,  -845,  -845,  4876,  -845,   524,
+     524,   277,  2573,  -845,   527,   524,  -845,  4658,   665,  -845,
+    -845,  -845,  -845,   680,   563,  -845,  -845,   357,  -845,  -845,
+    2967,  -845,   526,  -845,    88,   524,    32,  -845,   384,    82,
+    -845,  -845,  -845,  -845,  5621,    45,    45,  -845,  -845,   687,
+     533,   691,  -845,  -845,   535,   442,   534,  -845,   535,   524,
+     442,   537,   539,   442,   534,   699,  -845,   545,   847,  -845,
+    -845,  -845,    45,   714,   564,   434,  3874,  -845,  4985,   274,
+    -845,   534,   727,   122,   122,   122,   258,  -845,  -845,  -845,
+    4658,  4658,  -845,  -845,   571,  3983,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,   726,  5347,  -845,   470,   522,  -845,  1249,   730,   555,
+     561,  5523,  -845,  2490,   572,  1332,   875,  2490,    38,  4658,
+    4658,  4658,    48,  1353,    61,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  1514,  4658,    68,
+    4658,  4658,  4658,  4767,  2490,  1533,   753,  1552,   278,   731,
+    4658,  1616,   733,  3294,  4658,  4658,  4658,  4658,  4658,  4658,
+    4658,  4658,  4658,  4658,  4658,  4658,  4658,  4658,  3076,  4658,
+    3403,  3512,  -845,   185,  -845,  4658,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,    69,   534,   199,  1635,  -845,  -845,   734,
+     734,  1129,  1713,  -845,  -845,   576,  -845,  -845,   736,   470,
+     739,  -845,  -845,  -845,  5523,  3765,    79,  -845,   555,  -845,
+     740,   581,   582,   439,  -845,   743,  -845,   105,   734,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,   744,   717,  -845,   106,  2490,   588,
+     591,   280,  4092,  -845,  -845,  2490,  -845,   598,  4658,    31,
+     237,   594,   598,   595,   602,   125,  -845,  -845,  -845,   609,
+     609,  4658,   109,   533,  -845,   622,  2531,  -845,  -845,  -845,
+     622,   534,   534,   622,  -845,   545,   699,  -845,  -845,   534,
+    -845,   615,  -845,  -845,  -845,  -845,  -845,   123,  -845,  -845,
+     609,   618,  -845,   534,  -845,  3874,  3185,   585,   750,    34,
+    4201,  -845,  2490,   592,   534,    80,  4331,  5955,    78,  5879,
+      13,    85,  -845,   215,  2490,  2490,   524,  -845,   619,  2490,
+     616,   778,  -845,  2490,  2490,  2490,  2490,  2490,  2490,  2490,
+    4658,   337,  1249,  2490,   706,  1732,  -845,   779,  -845,  1249,
+    -845,  5523,  5523,  5523,  5523,  5523,   760,  4658,  -845,  4658,
+    -845,   111,   115,  1751,  -845,  -845,  -845,  1796,  1815,  1834,
+    1912,  1931,  1995,  2014,  2033,  2092,  2111,  2130,  2194,  -845,
+     121,  -845,   130,   136,   149,   781,   785,   786,  4767,  4767,
+    -845,  4767,   150,  -845,  4658,  4658,  2490,  -845,   542,   542,
+     806,   806,   875,   887,   887,   887,   887,   887,   887,   164,
+     164,   185,  4658,  4658,  2490,  -845,   185,  4658,   887,  4658,
+     887,   524,   787,  2640,   627,   629,   524,  -845,  -845,  -845,
+    -845,   295,  4658,  6031,  4658,  -845,  4658,    19,   631,   337,
+    -845,  -845,  2640,    83,  5347,  -845,  -845,  -845,  -845,    19,
+     632,   524,  -845,  2573,  -845,  4658,  -845,  4658,  -845,  -845,
+    -845,   771,    42,   547,  -845,  2213,   636,  -845,   637,  -845,
+     776,  4658,  4658,   135,  -845,   242,  -845,   774,  2490,  -845,
+    -845,   535,  4658,  -845,   151,  -845,  -845,  1253,   524,   780,
+     780,   545,  -845,  -845,   476,   847,  -845,  -845,   534,   780,
+     641,  4092,   750,  -845,   645,  -845,   644,  -845,  -845,   804,
+     688,   809,  -845,  2490,  -845,  -845,  -845,   773,   215,  -845,
+     215,   653,  -845,  -845,  -845,  -845,   652,   536,  -845,   215,
+    -845,  2749,   655,   664,  -845,  -845,   122,  -845,  -845,  -845,
+    3983,  2490,  -845,   152,  -845,  2490,  2490,  2490,  1249,   779,
+     570,   760,   760,   760,   593,  -845,  2490,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  -845,  -845,  -845,  5094,  5094,  5094,  2490,
+    -845,  2490,  -845,  2490,  -845,  -845,   667,   887,   887,   185,
+     887,   887,   470,  4658,  2858,  1415,   828,  -845,  -845,   513,
+    -845,   534,  -845,  -845,  2291,   670,  -845,   671,  -845,  2310,
+    1150,   829,  -845,  -845,  1233,   672,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,  2490,   153,  -845,   598,   598,   598,   598,
+     598,   522,  -845,   832,   676,  -845,  2329,  2374,  -845,  -845,
+    -845,  -845,   154,  -845,   678,  -845,  -845,  2490,  2531,  -845,
+    4440,  -845,  5203,  -845,  -845,   699,  -845,  -845,  -845,   679,
+    -845,   780,   231,  -845,   750,  -845,  4092,  -845,   291,   681,
+     683,  4658,   586,   215,   122,   122,  -845,  4658,   685,  -845,
+     454,  -845,   215,   122,  4658,  2490,   155,  -845,   842,  -845,
+    -845,  5955,   534,  -845,  1831,  2490,  -845,  -845,   832,   684,
+     686,   689,  -845,   690,  4658,  1435,  4658,  2640,  -845,  -845,
+     845,  4658,  4658,  -845,  4658,   524,  -845,   524,  -845,  -845,
+      66,    66,   693,   143,  4658,   833,  -845,   768,    60,  -845,
+     259,  -845,  -845,  -845,  2490,  4549,  -845,  2490,  -845,   231,
+    4658,  4658,  -845,  -845,  -845,   729,  -845,   851,  -845,  -845,
+    -845,   695,   696,   702,   215,  -845,   122,  2393,  -845,   703,
+    -845,  -845,   122,  5955,  -845,  2749,  -845,  4658,   534,   701,
+    2490,  -845,  -845,  -845,  -845,  2490,  4658,  1455,  -845,  4658,
+     704,  2412,  1171,   470,   697,  1192,   598,  -845,  -845,  -845,
+     157,   705,  -845,  2490,  2490,   709,   713,   716,  -845,  -845,
+     122,  4331,   784,  -845,  5955,  -845,  -845,  -845,  -845,  2490,
+    4658,  2490,  4658,  6107,  4658,  4658,   855,  -845,  -845,  -845,
+    -845,  -845,  4331,   719,  2490,  2490,  1213,  -845,  -845,  4658,
+    2490
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int16 yypgoto[] =
+{
+    -845,  -845,  -845,   -96,   830,   628,   -26,  -845,  -845,  -845,
+     399,   156,  -845,   -94,  -845,   -67,   -63,  -845,  -845,   232,
+    -845,  -845,  -845,   509,  -845,   234,    30,  -845,  -845,  -845,
+    -845,  -845,   444,  -464,  -845,  -845,  -238,   438,  -242,  -845,
+    -845,  -845,  -845,  -845,  -845,   -47,  -845,  -845,  -263,   417,
+     -27,   -50,   668,   437,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,   404,  -845,  -845,  -671,  -845,  -845,  -845,   642,  -231,
+    -656,  -845,  -845,   217,  -845,   882,  -236,  -845,    67,    70,
+     -11,   -78,    55,  -144,  -458,  -507,  -845,  -845,   -97,  -845,
+    -845,  -845,  -845,  -845,   540,  -845,     9,   279,     1,   -70,
+    -845,  -845,  -182,  -382,   365,   -20,  -128,  -845,  -845,  -845,
+      52,  -845,   -73,    43,  -845,  -630,  -845,  -515,  -514,  -844,
+    -845,  -845,  -845,  -845,  -566,  -718,  -845,  -845,  -845,  -845,
+    -294,  -845,  -845,  -845,  -845,  -845,  -185,  -845,  -845,  -845,
+    -845,  -845,  -845,  -663,  -845,  -845,  -845,  -845,  -845,  -845,
+    -845,  -845,  -845,   405,  -845,  -845,  -845,  -845,  -845,   -40,
+    -787,  -845,  -845,  -845,  -845,  -845,  -845,   -38,   190,    11,
+    -845,  -845,  -845,  -845,  -845,  -845,  -845,  -845,   191,  -845,
+    -845,  -845,  -845,   506,  -845,  -845,   288,  -384,  -845,  -845,
+    -845,   -39,   834,  -250,  -126,  -699,  -522,  -140,  -287,  -465,
+    -845,  -845,  -213,  -845,   519,  -845
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -542
+static const yytype_int16 yytable[] =
+{
+     174,   539,    93,   402,   192,   293,   434,   174,   294,   474,
+     641,   775,   295,   642,   506,   296,   243,   366,   690,   684,
+     414,   735,   736,   828,   684,   300,   494,   324,   372,   265,
+     498,   270,   271,   367,   686,   203,   273,  -171,   504,   874,
+     226,   579,   766,   767,    96,   846,   323,   198,   882,   257,
+     258,   579,    93,   268,   325,   534,   764,   764,   764,   203,
+     277,   847,   848,   849,   579,  -171,   885,   221,   222,   917,
+     366,   579,   646,   432,   430,   297,   607,   298,   299,   575,
+    -430,   859,   664,   365,   899,   329,   367,   849,   373,   374,
+     375,   376,   377,   378,    96,   379,   380,   381,   382,   383,
+     384,   332,   385,   386,   387,   388,   389,   729,   671,   675,
+     477,   174,   493,   203,   579,   419,   324,   984,   579,   333,
+     335,   336,   419,   285,   579,   750,   715,   483,   203,   540,
+     343,   126,  1021,   579,  -426,   323,   365,   223,   203,   579,
+     831,   224,   301,   325,   357,   307,   251,   194,   479,  -429,
+     364,   410,   579,   579,   868,   914,   675,   948,   985,  -425,
+     948,   371,   847,   848,   849,  -171,   393,   194,   648,   741,
+     484,   485,   229,   971,   438,   751,  1042,   223,   575,   170,
+     406,   224,   195,   230,   288,   387,   388,   389,   302,   404,
+     411,   412,   753,   742,  -171,   342,   480,   344,  -106,   394,
+    1026,   580,   197,   364,   308,   128,   364,   417,   389,   850,
+     959,   584,   359,  1000,   425,   917,   468,   204,   433,   605,
+     860,   436,  -430,   606,   586,   324,   466,   486,   963,   475,
+     564,   601,   647,   850,   324,   367,   960,   980,   495,     4,
+     730,   680,   665,   500,   323,   496,   503,   390,   391,   563,
+     478,   836,   325,   323,   716,    93,   130,   565,   916,   916,
+     916,   325,   252,   859,   286,   709,   710,   471,   672,   676,
+     499,   413,   699,   713,   777,   475,  -426,   532,   778,   170,
+     859,   609,   251,   561,   792,   365,   204,   719,   253,   544,
+     545,  -429,   576,   793,   549,   722,   413,    96,   728,   794,
+     694,  -425,   540,   553,   554,   555,   556,   557,   558,   559,
+     850,   575,   795,   805,   869,   915,   938,   949,   986,   266,
+    1037,   800,   802,   425,   804,   289,   575,   324,   390,   391,
+     583,   919,   920,   921,   587,   588,   589,   590,   591,   592,
+     593,   594,   595,   596,   597,   598,   323,   223,   131,   390,
+     391,   224,   371,   961,   325,   571,   311,   312,   572,   573,
+     574,   188,   616,   618,   619,   620,   621,   622,   623,   624,
+     625,   626,   627,   628,   629,   630,   631,   634,   636,   638,
+     640,    69,   939,   199,   192,   659,   372,   481,   684,   684,
+     684,   684,   684,   990,   581,   582,   697,   244,   252,   245,
+     191,   278,   860,   828,   610,   861,   482,   239,   764,   575,
+     407,   489,   490,   600,   663,   602,   603,   604,   202,   860,
+     415,   416,  1009,   400,   253,   612,   717,   837,   822,   279,
+     212,   923,   395,   679,   240,   241,   763,   408,   520,   264,
+     209,   235,   236,   769,   832,   701,   210,   756,   875,   989,
+     708,   965,   937,   711,  -156,   823,   839,   966,  -156,   208,
+     223,   475,   911,   866,   224,   564,   775,   685,   213,   255,
+     806,   256,   564,   219,   324,   324,   324,   324,   324,   259,
+     698,   260,   881,   916,   563,   707,   170,   309,   194,   274,
+     884,   563,   565,   323,   323,   323,   323,   323,   269,   565,
+     762,   325,   325,   325,   325,   325,   735,   736,   858,   800,
+     802,   804,   220,  -156,   475,   475,   227,  -156,   372,   371,
+     575,   575,   575,   575,   575,   733,   203,   735,   736,   280,
+     200,   201,   770,   771,   772,   773,   774,   746,    93,   979,
+      93,  -156,  1036,   231,   812,  -156,   232,   757,   684,   761,
+     376,   377,   378,   249,   379,   380,   381,   382,   383,   384,
+     419,   385,   386,   387,   388,   389,   733,   324,   776,   215,
+     216,   217,   419,   571,   311,   312,   572,   573,   574,  -541,
+    -541,  -541,  -541,  -541,  -541,   929,   323,   254,   139,   311,
+     312,   572,   573,   574,   325,   524,   525,   799,   801,   263,
+     803,   398,   668,   364,   807,   940,   941,   942,   943,   983,
+     876,   877,   878,   851,   572,   573,   574,   133,   134,   746,
+     898,   808,   809,   972,   973,   203,   810,   272,   811,   310,
+     327,   292,   815,   304,   305,   339,   340,   928,   394,   341,
+     345,   824,   894,   829,   895,   830,   346,   821,   347,   348,
+     349,   834,   806,   903,    93,   964,   350,   405,   351,   352,
+     353,   354,   355,   356,   843,   425,   468,   358,   469,   360,
+     361,   564,   841,   362,   370,   395,   988,   397,   398,   162,
+     856,   857,   399,   470,   170,   163,   164,   465,  1024,   476,
+     563,   867,   491,   259,   493,   266,   496,   501,   565,   502,
+     166,   167,   505,   168,   169,   274,   390,   391,   171,   871,
+     475,   373,   374,   375,   376,   377,   378,   521,   379,   380,
+     381,   382,   383,   384,   523,   385,   386,   387,   388,   389,
+     535,   560,   547,   569,   611,   577,   614,   651,   654,   674,
+     905,   656,   657,   609,   666,   667,   669,   673,   723,   549,
+     677,   678,  1027,   724,   688,   727,   608,   691,  -237,  -237,
+    -237,  -237,  -237,  -237,   692,  -237,  -237,  -237,  -237,  -237,
+    -237,   695,  -237,  -237,  -237,  -237,  -237,   714,   718,   759,
+     758,   760,   768,   574,   796,   799,   801,   803,   797,   798,
+     819,   813,   820,   845,   833,   840,   853,   976,   855,   478,
+     864,   872,   192,   925,   883,   886,   982,   887,   888,   891,
+     889,   372,   890,   896,   897,   909,   378,   564,   379,   380,
+     381,   382,   383,   384,   910,   385,   386,   387,   388,   389,
+     922,   927,   931,   932,   935,   936,   563,   944,  1003,   945,
+     950,   969,   958,   730,   565,   978,   987,   991,   999,   992,
+    1007,  1015,   993,   994,  1016,  1006,  1018,   707,  1017,   954,
+     850,   957,  1019,  1023,  1028,   302,  1043,  1032,  1038,  1039,
+     390,   391,   507,   965,   394,   475,  1041,  1047,  1020,  1048,
+     333,   234,   488,  1010,   693,  1008,   977,   379,   380,   381,
+     382,   383,   384,   905,   385,   386,   387,   388,   389,  -542,
+    -542,  -542,  -542,  -542,  -542,   842,   385,   386,   387,   388,
+     389,   844,    93,   995,   649,   997,   815,  -237,  -237,   689,
+     333,  1001,   712,  1002,   687,   235,   236,   508,   492,   720,
+     700,   533,   880,  1005,   238,   952,   998,   644,    93,  1012,
+     953,   835,   970,  1040,   371,  1025,   754,   912,  1004,  1013,
+    1014,   913,   838,   509,   670,   510,   511,   512,   330,     0,
+     513,   514,     0,   515,   516,     0,     0,     2,     3,     0,
+     390,   391,     0,     0,   905,     0,   905,     0,     0,     0,
+       0,     0,     0,     0,    93,  1029,     0,     0,  1031,     0,
+       0,     4,     5,     0,     0,     6,   -21,     7,   -21,     8,
+       0,     0,     9,     0,     0,     0,     0,     0,     0,     0,
+     733,     0,    10,     0,     0,     0,     0,     0,     0,  1044,
+       0,   733,     0,  1045,  1046,    93,     0,     0,    11,     0,
+       0,   733,    12,    13,    93,     0,     0,    14,  1050,   390,
+     391,     0,     0,    15,     0,    16,    17,     0,    18,     0,
+       0,   390,   391,    19,    20,    21,    22,    23,     0,    24,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,    36,     0,    37,     0,    38,    39,     0,
+       0,    40,    41,    42,     0,    43,     0,    44,     0,     0,
+      45,    46,     0,     0,    47,    48,    49,     0,     0,     0,
+       0,     0,     0,     0,    50,     0,     0,    51,    52,    53,
+      54,    55,    56,    57,    58,    59,    60,    61,    62,    63,
+       0,     0,    64,     0,     0,    65,    66,    67,    68,     0,
+       0,     0,   652,    69,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,   934,     0,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,  1034,     0,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,  1035,     0,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,  1049,     0,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   926,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   870,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,   135,   136,     0,     0,     0,     0,   137,   138,
+     139,   140,   141,   390,   391,     0,     0,     0,     0,     0,
+       0,     0,     0,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,   390,   391,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   390,   391,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   390,   391,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,     0,     0,   165,     0,     0,   613,   390,   391,     0,
+       0,     0,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   562,     0,     0,     0,     0,     0,   390,   391,   926,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   996,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,  1030,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   578,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   585,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,  -239,  -239,
+    -239,  -239,  -239,  -239,     0,  -239,  -239,  -239,  -239,  -239,
+    -239,     0,  -239,  -239,  -239,  -239,  -239,  -238,  -238,  -238,
+    -238,  -238,  -238,     0,  -238,  -238,  -238,  -238,  -238,  -238,
+       0,  -238,  -238,  -238,  -238,  -238,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   599,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,  -239,  -239,  -239,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,  -238,  -238,  -238,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   613,
+     390,   391,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   650,   390,
+     391,   373,   374,   375,   376,   377,   378,     0,   379,   380,
+     381,   382,   383,   384,     0,   385,   386,   387,   388,   389,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,     0,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,   653,   390,   391,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,   399,   149,   150,   151,   390,   391,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,   779,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,     0,     0,     0,     0,   780,
+     390,   391,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,   781,   390,
+     391,     0,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   918,   171,   562,     0,     0,     0,   782,   390,   391,
+     373,   374,   375,   376,   377,   378,     0,   379,   380,   381,
+     382,   383,   384,     0,   385,   386,   387,   388,   389,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   783,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   784,   390,   391,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,   785,   390,
+     391,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   786,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   787,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   788,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   789,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   790,   390,   391,   373,   374,   375,   376,
+     377,   378,     0,   379,   380,   381,   382,   383,   384,     0,
+     385,   386,   387,   388,   389,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,   373,   374,   375,   376,   377,   378,
+       0,   379,   380,   381,   382,   383,   384,     0,   385,   386,
+     387,   388,   389,     0,     0,     0,     0,   791,   390,   391,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   852,   390,   391,   373,
+     374,   375,   376,   377,   378,     0,   379,   380,   381,   382,
+     383,   384,     0,   385,   386,   387,   388,   389,   373,   374,
+     375,   376,   377,   378,     0,   379,   380,   381,   382,   383,
+     384,     0,   385,   386,   387,   388,   389,   373,   374,   375,
+     376,   377,   378,     0,   379,   380,   381,   382,   383,   384,
+       0,   385,   386,   387,   388,   389,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   930,   390,   391,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   933,   390,   391,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   946,   390,   391,   373,   374,   375,   376,   377,
+     378,     0,   379,   380,   381,   382,   383,   384,     0,   385,
+     386,   387,   388,   389,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   702,     0,   947,   390,   391,
+       0,     0,   132,     0,     0,     0,     0,     0,     0,     0,
+     133,   134,   703,     0,     0,     0,  1022,   390,   391,     0,
+       0,     0,     0,     0,   135,   136,     0,     0,     0,     0,
+     137,   138,   139,   140,   141,  1033,   390,   391,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,   439,   160,     0,
+       0,     0,   440,   441,     0,   442,   443,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   444,   445,   446,
+     447,   448,   449,   450,     0,   451,   452,   453,     0,     0,
+     454,   455,   456,     0,   814,   457,   458,   459,   460,     0,
+     461,   132,     0,     0,   390,   391,   161,     0,     0,   133,
+     134,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   462,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   904,     0,     0,     0,     0,     0,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+       0,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   924,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   472,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,   473,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   632,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,   633,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   172,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     721,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,   473,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   171,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   615,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   172,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   637,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   170,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   639,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,     0,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,     0,     0,   165,     0,     0,     0,     0,
+       0,     0,     0,     0,   166,   167,   132,   168,   169,     0,
+       0,   170,   171,   172,   133,   134,   660,   173,   661,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   135,   136,
+       0,     0,     0,     0,   137,   138,   139,   140,   141,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,   473,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   171,   662,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,   548,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   526,   171,   172,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,   132,     0,     0,     0,     0,   161,     0,
+       0,   133,   134,   473,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,   135,   136,   165,     0,     0,
+       0,   137,   138,   139,   140,   141,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   172,   142,   143,   144,   145,
+     146,   147,   148,     0,   149,   150,   151,     0,     0,   152,
+     153,   154,     0,   155,   156,   157,   158,   159,     0,   160,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,   132,     0,     0,     0,     0,   161,     0,     0,
+     133,   134,   726,     0,   162,     0,     0,     0,     0,     0,
+     163,   164,     0,     0,   135,   136,   165,     0,     0,     0,
+     137,   138,   139,   140,   141,   166,   167,     0,   168,   169,
+       0,     0,   170,   171,   172,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   161,     0,     0,     0,
+       0,     0,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,   132,     0,     0,   165,     0,     0,     0,     0,
+     133,   134,     0,     0,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   135,   136,     9,     0,     0,     0,
+     137,   138,   139,   140,   141,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   142,   143,   144,   145,   146,
+     147,   148,     0,   149,   150,   151,     0,     0,   152,   153,
+     154,     0,   155,   156,   157,   158,   159,     0,   160,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,   132,     0,     0,     0,     0,   161,     0,     0,   133,
+     134,   703,     0,   162,     0,     0,     0,     0,     0,   163,
+     164,     0,     0,   135,   136,   165,     0,     0,     0,   137,
+     138,   139,   140,   141,   166,   167,     0,   168,   169,     0,
+       0,   170,   171,   172,   142,   143,   144,   145,   146,   147,
+     148,     0,   149,   150,   151,     0,     0,   152,   153,   154,
+       0,   155,   156,   157,   158,   159,     0,   160,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     132,     0,     0,     0,     0,   161,     0,     0,   133,   134,
+    1011,     0,   162,     0,     0,     0,     0,     0,   163,   164,
+       0,     0,   135,   136,   165,     0,     0,     0,   137,   138,
+     139,   140,   141,   166,   167,     0,   168,   169,     0,     0,
+     170,   171,   172,   142,   143,   144,   145,   146,   147,   148,
+       0,   149,   150,   151,     0,     0,   152,   153,   154,     0,
+     155,   156,   157,   158,   159,     0,   160,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   132,
+       0,     0,     0,     0,   161,     0,     0,   133,   134,     0,
+       0,   162,     0,     0,     0,     0,     0,   163,   164,     0,
+       0,   135,   136,   165,     0,     0,     0,   137,   138,   139,
+     140,   141,   166,   167,     0,   168,   169,     0,     0,   170,
+     171,   172,   142,   143,   144,   145,   146,   147,   148,     0,
+     149,   150,   151,     0,     0,   152,   153,   154,     0,   155,
+     156,   157,   158,   159,     0,   160,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   132,     0,
+       0,     0,     0,   161,     0,     0,   133,   134,     0,     0,
+     162,     0,     0,     0,     0,     0,   163,   164,     0,     0,
+     135,   136,   165,     0,     0,     0,   137,   138,   139,   140,
+     141,   166,   167,     0,   168,   169,     0,     0,   170,   171,
+     172,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   132,     0,     0,
+       0,     0,   161,     0,     0,   133,   134,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,   135,
+     136,   165,     0,     0,     0,   137,   138,   139,   140,   141,
+     166,   167,     0,   168,   169,     0,     0,   170,   171,   363,
+     142,   143,   144,   145,   146,   147,   148,     0,   149,   150,
+     151,     0,     0,   152,   153,   154,     0,   155,   156,   157,
+     158,   159,     0,   160,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   132,     0,     0,     0,
+       0,   161,     0,     0,   133,   134,     0,     0,   162,     0,
+       0,     0,     0,     0,   163,   164,     0,     0,   135,   136,
+     165,     0,     0,     0,   137,   138,   139,   140,   141,   166,
+     167,     0,   168,   169,     0,     0,   170,   431,   172,   142,
+     143,   144,   145,   146,   147,   148,     0,   149,   150,   151,
+       0,     0,   152,   153,   154,     0,   155,   156,   157,   158,
+     159,     0,   160,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,   132,     0,     0,     0,     0,
+     161,     0,     0,   133,   134,     0,     0,   162,     0,     0,
+       0,     0,     0,   163,   164,     0,     0,   135,   136,   165,
+       0,     0,     0,   137,   138,   139,   140,   141,   166,   167,
+       0,   168,   169,     0,     0,   170,   529,   530,   142,   143,
+     144,   145,   146,   147,   148,     0,   149,   150,   151,     0,
+       0,   152,   153,   154,     0,   155,   156,   157,   158,   159,
+       0,   160,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,   132,     0,     0,     0,     0,   161,
+       0,     0,   133,   134,     0,     0,   162,     0,     0,     0,
+       0,     0,   163,   164,     0,     0,   135,   136,   165,     0,
+       0,     0,   137,   138,   139,   140,   141,   166,   167,     0,
+     168,   169,     0,     0,   918,   171,   363,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,   161,     0,
+       0,     0,     0,     0,     0,   162,     0,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,     0,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,     0,   170,   171,   955,   311,   312,   422,     0,
+     423,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,     0,     0,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,   311,   312,   313,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   424,
+     135,   136,     0,     0,     0,     0,   137,   138,   139,   140,
+     141,     0,     0,   314,   315,   316,   317,   318,     0,   319,
+     320,   142,   143,   144,   145,   146,   147,   148,     0,   149,
+     150,   151,   311,   312,   152,   153,   154,     0,   155,   156,
+     157,   158,   159,     0,   160,     0,   135,   136,     0,     0,
+       0,     0,   137,   138,   139,   140,   141,     0,     0,   314,
+     315,   316,   317,   318,     0,   319,   320,   142,   143,   144,
+     145,   146,   147,   148,     0,   149,   150,   151,     0,     0,
+     152,   153,   154,     0,   155,   156,   157,   158,   159,     0,
+     160,     0,     0,     0,     0,     0,     0,     0,     0,   162,
+       0,     0,     0,     0,     0,   163,   164,     0,     0,     0,
+       0,   165,     0,     0,     0,     0,     0,     0,     0,     0,
+     166,   167,     0,   168,   169,     0,     0,   321,   171,   322,
+       0,     0,     0,     0,     0,     0,     5,     0,     0,     6,
+       0,     7,     0,     8,     0,   162,     9,     0,     0,     0,
+       0,   163,   164,     0,     0,     0,    10,   165,     0,     0,
+       0,     0,     0,     0,     0,     0,   166,   167,     0,   168,
+     169,     0,    11,   321,   171,   424,    12,    13,     0,     0,
+       0,    14,     0,     0,     0,     0,     0,    15,     0,    16,
+      17,     0,    18,     0,     0,     0,     0,    19,    20,    21,
+      22,    23,     0,    24,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,    36,     0,    37,
+       0,    38,    39,     0,     0,    40,    41,    42,     0,    43,
+       0,    44,     0,     0,    45,    46,     0,     0,    47,    48,
+      49,     0,     0,     0,     0,     0,     0,     0,    50,     0,
+       0,     0,    52,    53,    54,    55,    56,    57,    58,    59,
+      60,    61,    62,    63,     0,     0,    64,     0,     0,    65,
+      66,    67,    68,     5,     0,     0,     6,   487,     7,     0,
+       8,     0,     0,     9,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    10,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    11,
+       0,     0,     0,    12,    13,     0,     0,     0,    14,     0,
+       0,     0,     0,     0,    15,     0,    16,    17,     0,    18,
+       0,     0,     0,     0,    19,    20,    21,    22,    23,     0,
+      24,    25,     0,     0,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,     0,    37,     0,    38,    39,
+       0,     0,    40,    41,    42,     0,    43,     0,    44,     0,
+       0,    45,    46,     0,     0,    47,    48,    49,     0,     0,
+       0,     0,     0,     0,     0,    50,     0,     0,     0,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    61,    62,
+      63,     8,     0,    64,     9,     0,    65,    66,    67,    68,
+       0,     0,     0,     0,    10,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+      11,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,    15,     0,     0,     0,     0,
+      18,     0,   746,     0,     0,    19,    20,    21,    22,    23,
+       0,     0,    25,     0,     0,    26,    27,    28,    29,    30,
+      31,    32,    33,    34,    35,     0,     0,     8,     0,     0,
+       9,     0,     0,     0,    41,     0,     0,     0,     0,    44,
+      10,     0,     0,     0,     0,     0,    47,     0,    49,     0,
+       0,     0,     0,     0,     0,     0,    11,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,    59,    60,    61,
+      62,    15,     0,     0,     0,     0,    18,     0,     0,    67,
+      68,    19,    20,    21,    22,    23,     0,     0,    25,     0,
+       0,    26,    27,    28,    29,    30,    31,    32,    33,    34,
+      35,     0,     0,     0,     0,     0,   825,     0,     0,     0,
+      41,     0,     0,     0,     0,    44,     0,     0,     0,     0,
+       0,     0,    47,     0,    49,     0,     0,     0,     0,     0,
+       0,     0,    11,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,    59,    60,    61,    62,    15,     0,     0,
+       0,     0,    18,   826,     0,    67,    68,    19,    20,   827,
+       0,    23,     0,     0,    25,     0,     0,    26,    27,    28,
+      29,    30,    31,    32,    33,    34,    35,     0,     0,     0,
+       0,     0,   825,     0,     0,     0,    41,     0,     0,     0,
+       0,    44,     0,     0,     0,     0,     0,     0,    47,     0,
+      49,     0,     0,     0,     0,     0,     0,     0,    11,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    59,
+      60,    61,    62,    15,     0,     0,     0,     0,    18,     0,
+       0,   170,    68,    19,    20,   827,     0,    23,     0,     0,
+      25,     0,     0,    26,    27,    28,    29,    30,    31,    32,
+      33,    34,    35,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,    41,     0,     0,     0,     0,    44,     0,     0,
+       0,     0,     0,     0,    47,     0,    49,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,    59,    60,    61,    62,     0,
+       0,     0,     0,     0,     0,     0,     0,   170,    68
+};
+
+#define yypact_value_is_default(Yystate) \
+  (!!((Yystate) == (-845)))
+
+#define yytable_value_is_error(Yytable_value) \
+  (!!((Yytable_value) == (-542)))
+
+static const yytype_int16 yycheck[] =
+{
+      11,   295,     1,   185,    15,   101,   219,    18,   104,   240,
+     394,   577,   108,   395,   277,   111,    54,   161,   482,   477,
+     205,   536,   536,   653,   482,     5,   264,   124,   172,    79,
+     268,    81,    82,   161,     3,     3,    86,     3,   274,   710,
+      39,     3,   564,   565,     1,     3,   124,    17,   719,    75,
+      76,     3,    51,    80,   124,   291,   563,   564,   565,     3,
+      87,    19,    20,    21,     3,    31,   722,    37,    38,   768,
+     214,     3,     3,   217,   214,   113,   363,   115,   116,   329,
+      24,    21,     3,   161,   747,   124,   214,    21,     5,     6,
+       7,     8,     9,    10,    51,    12,    13,    14,    15,    16,
+      17,   127,    19,    20,    21,    22,    23,    27,     3,     3,
+      22,   122,     3,     3,     3,   212,   213,   904,     3,   130,
+     131,   132,   219,    21,     3,   112,     3,    45,     3,    44,
+     141,   153,   976,     3,    24,   213,   214,    18,     3,     3,
+     121,    22,   122,   213,   155,   101,    24,   131,   245,    24,
+     161,   198,     3,     3,     3,     3,     3,     3,     3,    24,
+       3,   172,    19,    20,    21,   131,   177,   131,   404,    91,
+      88,    89,   119,   891,   221,   162,  1020,    18,   428,   160,
+     191,    22,   166,   130,    21,    21,    22,    23,   168,   188,
+     201,   202,   107,   115,   160,   140,   246,   142,   166,   168,
+     987,   163,   166,   214,   160,   160,   217,   206,    23,   167,
+     881,   163,   157,   931,   213,   914,   227,   161,   217,   363,
+     160,   220,   166,   363,   163,   322,   225,   253,   884,   240,
+     327,   163,   163,   167,   331,   363,     5,   900,   265,    24,
+     160,   472,   163,   270,   322,   162,   273,   164,   165,   327,
+     162,   168,   322,   331,   131,   254,   162,   327,   765,   766,
+     767,   331,   140,    21,   162,   501,   502,   237,   163,   163,
+     269,   161,   163,   509,   163,   286,   166,   288,   163,   160,
+      21,     3,    24,   322,   163,   363,   161,   523,   166,   300,
+     301,   166,   331,   163,   305,   526,   161,   254,   534,   163,
+     485,   166,    44,   314,   315,   316,   317,   318,   319,   320,
+     167,   561,   163,   163,   163,   163,   163,   163,   163,   160,
+     163,   608,   609,   322,   611,   162,   576,   424,   164,   165,
+     341,   796,   797,   798,   345,   346,   347,   348,   349,   350,
+     351,   352,   353,   354,   355,   356,   424,    18,   162,   164,
+     165,    22,   363,   122,   424,    18,    19,    20,    21,    22,
+      23,   162,   373,   374,   375,   376,   377,   378,   379,   380,
+     381,   382,   383,   384,   385,   386,   387,   388,   389,   390,
+     391,   166,   846,    18,   395,   424,   530,     3,   846,   847,
+     848,   849,   850,   915,   339,   340,   490,   160,   140,   162,
+     162,     3,   160,  1033,   126,   163,    22,   133,   915,   659,
+     133,   255,   256,   358,   425,   360,   361,   362,   162,   160,
+      94,    95,   163,   153,   166,   370,   520,   663,   133,    31,
+     162,   813,   162,   471,   160,   161,   562,   160,   282,     3,
+     160,    78,    79,   569,   657,   495,   166,   543,   711,   914,
+     500,   160,   836,   503,    18,   160,   669,   166,    22,   160,
+      18,   472,   756,   701,    22,   562,  1032,   478,   162,    29,
+     614,    31,   569,   162,   571,   572,   573,   574,   575,   160,
+     491,   162,   718,   990,   562,   496,   160,   122,   131,   160,
+     721,   569,   562,   571,   572,   573,   574,   575,     3,   569,
+     163,   571,   572,   573,   574,   575,  1021,  1021,   693,   796,
+     797,   798,   162,    18,   525,   526,   162,    22,   662,   530,
+     770,   771,   772,   773,   774,   536,     3,  1042,  1042,   131,
+     161,   162,   571,   572,   573,   574,   575,    83,   537,    85,
+     539,    18,  1006,   123,   641,    22,   160,   546,  1006,   560,
+       8,     9,    10,     4,    12,    13,    14,    15,    16,    17,
+     657,    19,    20,    21,    22,    23,   577,   664,   579,   160,
+     161,   162,   669,    18,    19,    20,    21,    22,    23,    18,
+      19,    20,    21,    22,    23,   821,   664,    24,    41,    19,
+      20,    21,    22,    23,   664,   161,   162,   608,   609,   166,
+     611,   162,   163,   614,   615,   847,   848,   849,   850,   903,
+     134,   135,   136,   683,    21,    22,    23,    19,    20,    83,
+      84,   632,   633,    37,    38,     3,   637,     3,   639,   123,
+     124,   160,   643,     3,   162,   162,   162,   819,   168,   162,
+     162,   652,   738,   654,   740,   656,   162,   646,   162,   162,
+     162,   662,   796,   749,   653,   886,   162,     3,   162,   162,
+     162,   162,   162,   162,   675,   664,   677,   162,     3,   162,
+     162,   768,   671,   162,   162,   162,   912,   162,   162,   132,
+     691,   692,   160,     3,   160,   138,   139,   160,   982,   163,
+     768,   702,     5,   160,     3,   160,   162,   160,   768,   160,
+     153,   154,     3,   156,   157,   160,   164,   165,   161,   708,
+     721,     5,     6,     7,     8,     9,    10,     3,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+       3,     5,   161,     3,     3,   163,     3,     3,   162,    22,
+     751,     5,     3,     3,   163,   163,     3,     3,   163,   760,
+     162,   160,   988,     3,   160,   163,     3,   162,     5,     6,
+       7,     8,     9,    10,   162,    12,    13,    14,    15,    16,
+      17,   162,    19,    20,    21,    22,    23,   162,   160,   163,
+     161,     3,     3,    23,     3,   796,   797,   798,     3,     3,
+     163,     4,   163,    22,   163,   163,   160,   893,    22,   162,
+      26,    21,   813,   814,   163,   160,   902,   163,     4,    36,
+     122,   955,     3,   160,   162,   160,    10,   914,    12,    13,
+      14,    15,    16,    17,   160,    19,    20,    21,    22,    23,
+     163,     3,   162,   162,     5,   163,   914,     5,   935,   163,
+     162,   160,   163,   160,   914,   160,     4,   163,     3,   163,
+      82,   122,   163,   163,     3,    22,   160,   868,   163,   870,
+     167,   872,   160,   160,   163,   168,    82,   163,   163,   160,
+     164,   165,    25,   160,   168,   886,   160,    22,   974,   160,
+     891,    51,   254,   950,   485,   948,   897,    12,    13,    14,
+      15,    16,    17,   904,    19,    20,    21,    22,    23,    12,
+      13,    14,    15,    16,    17,   673,    19,    20,    21,    22,
+      23,   677,   911,   924,   405,   926,   927,   164,   165,   481,
+     931,   932,   505,   934,   480,    78,    79,    80,   260,   525,
+     493,   289,   715,   944,    52,   868,   927,   397,   937,   959,
+     870,   662,   890,  1016,   955,   985,   541,   757,   937,   960,
+     961,   760,   664,   106,   435,   108,   109,   110,   124,    -1,
+     113,   114,    -1,   116,   117,    -1,    -1,     0,     1,    -1,
+     164,   165,    -1,    -1,   985,    -1,   987,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   983,   996,    -1,    -1,   999,    -1,
+      -1,    24,    25,    -1,    -1,    28,    29,    30,    31,    32,
+      -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+    1021,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,  1030,
+      -1,  1032,    -1,  1034,  1035,  1024,    -1,    -1,    61,    -1,
+      -1,  1042,    65,    66,  1033,    -1,    -1,    70,  1049,   164,
+     165,    -1,    -1,    76,    -1,    78,    79,    -1,    81,    -1,
+      -1,   164,   165,    86,    87,    88,    89,    90,    -1,    92,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,   106,    -1,   108,    -1,   110,   111,    -1,
+      -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,    -1,
+     123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   137,    -1,    -1,   140,   141,   142,
+     143,   144,   145,   146,   147,   148,   149,   150,   151,   152,
+      -1,    -1,   155,    -1,    -1,   158,   159,   160,   161,    -1,
+      -1,    -1,     3,   166,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,     3,    -1,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     3,    -1,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     3,    -1,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     3,    -1,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     4,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    33,    34,    -1,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   164,   165,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,   164,   165,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,   164,   165,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    -1,    -1,   144,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    -1,    -1,    -1,    -1,    -1,   164,   165,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     4,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
+     164,   165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,
+     165,     5,     6,     7,     8,     9,    10,    -1,    12,    13,
+      14,    15,    16,    17,    -1,    19,    20,    21,    22,    23,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,    -1,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,   160,    62,    63,    64,   164,   165,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,
+     164,   165,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    -1,    -1,    -1,   163,   164,   165,
+       5,     6,     7,     8,     9,    10,    -1,    12,    13,    14,
+      15,    16,    17,    -1,    19,    20,    21,    22,    23,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,
+     165,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   163,   164,   165,     5,     6,     7,     8,
+       9,    10,    -1,    12,    13,    14,    15,    16,    17,    -1,
+      19,    20,    21,    22,    23,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,     5,     6,     7,     8,     9,    10,
+      -1,    12,    13,    14,    15,    16,    17,    -1,    19,    20,
+      21,    22,    23,    -1,    -1,    -1,    -1,   163,   164,   165,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   163,   164,   165,     5,
+       6,     7,     8,     9,    10,    -1,    12,    13,    14,    15,
+      16,    17,    -1,    19,    20,    21,    22,    23,     5,     6,
+       7,     8,     9,    10,    -1,    12,    13,    14,    15,    16,
+      17,    -1,    19,    20,    21,    22,    23,     5,     6,     7,
+       8,     9,    10,    -1,    12,    13,    14,    15,    16,    17,
+      -1,    19,    20,    21,    22,    23,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   163,   164,   165,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   163,   164,   165,     5,     6,     7,     8,     9,
+      10,    -1,    12,    13,    14,    15,    16,    17,    -1,    19,
+      20,    21,    22,    23,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,     4,    -1,   163,   164,   165,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      19,    20,    21,    -1,    -1,    -1,   163,   164,   165,    -1,
+      -1,    -1,    -1,    -1,    33,    34,    -1,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   163,   164,   165,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    34,    77,    -1,
+      -1,    -1,    39,    40,    -1,    42,    43,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,     4,    72,    73,    74,    75,    -1,
+      77,    11,    -1,    -1,   164,   165,   125,    -1,    -1,    19,
+      20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   160,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     4,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    21,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,     5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    22,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+       5,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,     5,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,   153,   154,    11,   156,   157,    -1,
+      -1,   160,   161,   162,    19,    20,    21,   166,    23,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    33,    34,
+      -1,    -1,    -1,    -1,    39,    40,    41,    42,    43,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,
+      -1,    39,    40,    41,    42,    43,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    54,    55,    56,    57,
+      58,    59,    60,    -1,    62,    63,    64,    -1,    -1,    67,
+      68,    69,    -1,    71,    72,    73,    74,    75,    -1,    77,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,
+      19,    20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,
+     138,   139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,   153,   154,    -1,   156,   157,
+      -1,    -1,   160,   161,   162,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,    -1,    -1,
+      -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    11,    -1,    -1,   144,    -1,    -1,    -1,    -1,
+      19,    20,    -1,    -1,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    33,    34,    35,    -1,    -1,    -1,
+      39,    40,    41,    42,    43,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    54,    55,    56,    57,    58,
+      59,    60,    -1,    62,    63,    64,    -1,    -1,    67,    68,
+      69,    -1,    71,    72,    73,    74,    75,    -1,    77,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,
+      20,    21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,
+     139,    -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,
+      40,    41,    42,    43,   153,   154,    -1,   156,   157,    -1,
+      -1,   160,   161,   162,    54,    55,    56,    57,    58,    59,
+      60,    -1,    62,    63,    64,    -1,    -1,    67,    68,    69,
+      -1,    71,    72,    73,    74,    75,    -1,    77,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      11,    -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,
+      21,    -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,
+      -1,    -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,
+      41,    42,    43,   153,   154,    -1,   156,   157,    -1,    -1,
+     160,   161,   162,    54,    55,    56,    57,    58,    59,    60,
+      -1,    62,    63,    64,    -1,    -1,    67,    68,    69,    -1,
+      71,    72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,
+      -1,    -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,
+      -1,   132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,
+      -1,    33,    34,   144,    -1,    -1,    -1,    39,    40,    41,
+      42,    43,   153,   154,    -1,   156,   157,    -1,    -1,   160,
+     161,   162,    54,    55,    56,    57,    58,    59,    60,    -1,
+      62,    63,    64,    -1,    -1,    67,    68,    69,    -1,    71,
+      72,    73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,
+      -1,    -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,
+     132,    -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,
+      33,    34,   144,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,   153,   154,    -1,   156,   157,    -1,    -1,   160,   161,
+     162,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,
+      -1,    -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,
+      34,   144,    -1,    -1,    -1,    39,    40,    41,    42,    43,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      54,    55,    56,    57,    58,    59,    60,    -1,    62,    63,
+      64,    -1,    -1,    67,    68,    69,    -1,    71,    72,    73,
+      74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,
+      -1,   125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,
+      -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,
+     144,    -1,    -1,    -1,    39,    40,    41,    42,    43,   153,
+     154,    -1,   156,   157,    -1,    -1,   160,   161,   162,    54,
+      55,    56,    57,    58,    59,    60,    -1,    62,    63,    64,
+      -1,    -1,    67,    68,    69,    -1,    71,    72,    73,    74,
+      75,    -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,
+     125,    -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,
+      -1,    -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,
+      -1,    -1,    -1,    39,    40,    41,    42,    43,   153,   154,
+      -1,   156,   157,    -1,    -1,   160,   161,   162,    54,    55,
+      56,    57,    58,    59,    60,    -1,    62,    63,    64,    -1,
+      -1,    67,    68,    69,    -1,    71,    72,    73,    74,    75,
+      -1,    77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    11,    -1,    -1,    -1,    -1,   125,
+      -1,    -1,    19,    20,    -1,    -1,   132,    -1,    -1,    -1,
+      -1,    -1,   138,   139,    -1,    -1,    33,    34,   144,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,   153,   154,    -1,
+     156,   157,    -1,    -1,   160,   161,   162,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   125,    -1,
+      -1,    -1,    -1,    -1,    -1,   132,    -1,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    -1,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    -1,   160,   161,   162,    19,    20,    21,    -1,
+      23,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    -1,    -1,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    19,    20,    21,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      33,    34,    -1,    -1,    -1,    -1,    39,    40,    41,    42,
+      43,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
+      53,    54,    55,    56,    57,    58,    59,    60,    -1,    62,
+      63,    64,    19,    20,    67,    68,    69,    -1,    71,    72,
+      73,    74,    75,    -1,    77,    -1,    33,    34,    -1,    -1,
+      -1,    -1,    39,    40,    41,    42,    43,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    58,    59,    60,    -1,    62,    63,    64,    -1,    -1,
+      67,    68,    69,    -1,    71,    72,    73,    74,    75,    -1,
+      77,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   132,
+      -1,    -1,    -1,    -1,    -1,   138,   139,    -1,    -1,    -1,
+      -1,   144,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+     153,   154,    -1,   156,   157,    -1,    -1,   160,   161,   162,
+      -1,    -1,    -1,    -1,    -1,    -1,    25,    -1,    -1,    28,
+      -1,    30,    -1,    32,    -1,   132,    35,    -1,    -1,    -1,
+      -1,   138,   139,    -1,    -1,    -1,    45,   144,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,   153,   154,    -1,   156,
+     157,    -1,    61,   160,   161,   162,    65,    66,    -1,    -1,
+      -1,    70,    -1,    -1,    -1,    -1,    -1,    76,    -1,    78,
+      79,    -1,    81,    -1,    -1,    -1,    -1,    86,    87,    88,
+      89,    90,    -1,    92,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,   106,    -1,   108,
+      -1,   110,   111,    -1,    -1,   114,   115,   116,    -1,   118,
+      -1,   120,    -1,    -1,   123,   124,    -1,    -1,   127,   128,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   137,    -1,
+      -1,    -1,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,    -1,    -1,   155,    -1,    -1,   158,
+     159,   160,   161,    25,    -1,    -1,    28,   166,    30,    -1,
+      32,    -1,    -1,    35,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,
+      -1,    -1,    -1,    65,    66,    -1,    -1,    -1,    70,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    78,    79,    -1,    81,
+      -1,    -1,    -1,    -1,    86,    87,    88,    89,    90,    -1,
+      92,    93,    -1,    -1,    96,    97,    98,    99,   100,   101,
+     102,   103,   104,   105,   106,    -1,   108,    -1,   110,   111,
+      -1,    -1,   114,   115,   116,    -1,   118,    -1,   120,    -1,
+      -1,   123,   124,    -1,    -1,   127,   128,   129,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   137,    -1,    -1,    -1,   141,
+     142,   143,   144,   145,   146,   147,   148,   149,   150,   151,
+     152,    32,    -1,   155,    35,    -1,   158,   159,   160,   161,
+      -1,    -1,    -1,    -1,    45,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,
+      81,    -1,    83,    -1,    -1,    86,    87,    88,    89,    90,
+      -1,    -1,    93,    -1,    -1,    96,    97,    98,    99,   100,
+     101,   102,   103,   104,   105,    -1,    -1,    32,    -1,    -1,
+      35,    -1,    -1,    -1,   115,    -1,    -1,    -1,    -1,   120,
+      45,    -1,    -1,    -1,    -1,    -1,   127,    -1,   129,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,   149,   150,
+     151,    76,    -1,    -1,    -1,    -1,    81,    -1,    -1,   160,
+     161,    86,    87,    88,    89,    90,    -1,    -1,    93,    -1,
+      -1,    96,    97,    98,    99,   100,   101,   102,   103,   104,
+     105,    -1,    -1,    -1,    -1,    -1,    35,    -1,    -1,    -1,
+     115,    -1,    -1,    -1,    -1,   120,    -1,    -1,    -1,    -1,
+      -1,    -1,   127,    -1,   129,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,   148,   149,   150,   151,    76,    -1,    -1,
+      -1,    -1,    81,    82,    -1,   160,   161,    86,    87,    88,
+      -1,    90,    -1,    -1,    93,    -1,    -1,    96,    97,    98,
+      99,   100,   101,   102,   103,   104,   105,    -1,    -1,    -1,
+      -1,    -1,    35,    -1,    -1,    -1,   115,    -1,    -1,    -1,
+      -1,   120,    -1,    -1,    -1,    -1,    -1,    -1,   127,    -1,
+     129,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    61,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,   148,
+     149,   150,   151,    76,    -1,    -1,    -1,    -1,    81,    -1,
+      -1,   160,   161,    86,    87,    88,    -1,    90,    -1,    -1,
+      93,    -1,    -1,    96,    97,    98,    99,   100,   101,   102,
+     103,   104,   105,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,   115,    -1,    -1,    -1,    -1,   120,    -1,    -1,
+      -1,    -1,    -1,    -1,   127,    -1,   129,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,   148,   149,   150,   151,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,   160,   161
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint16 yystos[] =
+{
+       0,   170,     0,     1,    24,    25,    28,    30,    32,    35,
+      45,    61,    65,    66,    70,    76,    78,    79,    81,    86,
+      87,    88,    89,    90,    92,    93,    96,    97,    98,    99,
+     100,   101,   102,   103,   104,   105,   106,   108,   110,   111,
+     114,   115,   116,   118,   120,   123,   124,   127,   128,   129,
+     137,   140,   141,   142,   143,   144,   145,   146,   147,   148,
+     149,   150,   151,   152,   155,   158,   159,   160,   161,   166,
+     171,   172,   173,   174,   176,   178,   186,   198,   199,   203,
+     204,   209,   210,   211,   212,   213,   215,   216,   223,   225,
+     228,   231,   232,   267,   276,   277,   282,   283,   284,   286,
+     287,   291,   300,   301,   302,   303,   304,   310,   315,   319,
+     320,   323,   331,   332,   333,   334,   335,   338,   339,   341,
+     344,   345,   348,   357,   359,   369,   153,   181,   160,   180,
+     162,   162,    11,    19,    20,    33,    34,    39,    40,    41,
+      42,    43,    54,    55,    56,    57,    58,    59,    60,    62,
+      63,    64,    67,    68,    69,    71,    72,    73,    74,    75,
+      77,   125,   132,   138,   139,   144,   153,   154,   156,   157,
+     160,   161,   162,   166,   249,   250,   252,   253,   257,   259,
+     260,   261,   262,   267,   268,   269,   273,   275,   162,   191,
+     192,   162,   249,   272,   131,   166,   195,   166,   195,   273,
+     161,   162,   162,     3,   161,   179,   220,   305,   160,   160,
+     166,   336,   162,   162,   352,   160,   161,   162,   353,   162,
+     162,   195,   195,    18,    22,   219,   267,   162,   190,   119,
+     130,   123,   160,   224,   173,    78,    79,   187,   244,   133,
+     160,   161,   237,   336,   160,   162,   200,   201,   206,     4,
+     175,    24,   140,   166,    24,    29,    31,   175,   175,   160,
+     162,   221,   222,   166,     3,   220,   160,   205,   219,     3,
+     220,   220,     3,   220,   160,   217,   218,   219,     3,    31,
+     131,   196,   197,   226,   240,    21,   162,   229,    21,   162,
+     235,   337,   160,   172,   172,   172,   172,   336,   336,   336,
+       5,   122,   168,   340,     3,   162,   342,   101,   160,   273,
+     352,    19,    20,    21,    46,    47,    48,    49,    50,    52,
+      53,   160,   162,   250,   257,   268,   350,   352,   358,   360,
+     361,   362,   175,   249,   294,   249,   249,   249,   251,   162,
+     162,   162,   251,   249,   251,   162,   162,   162,   162,   162,
+     162,   162,   162,   162,   162,   162,   162,   249,   162,   251,
+     162,   162,   162,   162,   249,   250,   252,   275,   366,   367,
+     162,   249,   252,     5,     6,     7,     8,     9,    10,    12,
+      13,    14,    15,    16,    17,    19,    20,    21,    22,    23,
+     164,   165,   254,   249,   168,   162,   271,   162,   162,   160,
+     153,   270,   271,   193,   267,     3,   249,   133,   160,   214,
+     214,   249,   249,   161,   305,    94,    95,   267,   306,   257,
+     370,   371,    21,    23,   162,   267,   354,   355,   360,   361,
+     366,   161,   252,   267,   371,   372,   267,   374,   214,    34,
+      39,    40,    42,    43,    54,    55,    56,    57,    58,    59,
+      60,    62,    63,    64,    67,    68,    69,    72,    73,    74,
+      75,    77,   160,   188,   189,   160,   267,   194,   249,     3,
+       3,   195,     5,    21,   238,   249,   163,    22,   162,   257,
+     220,     3,    22,    45,    88,    89,   175,   166,   174,   180,
+     180,     5,   221,     3,   205,   219,   162,   245,   205,   267,
+     219,   160,   160,   219,   245,     3,   217,    25,    80,   106,
+     108,   109,   110,   113,   114,   116,   117,   241,   242,   244,
+     180,     3,   227,   160,   161,   162,   160,   230,   238,   161,
+     162,   236,   249,   237,   245,     3,   288,   299,   307,   299,
+      44,   321,   322,   324,   249,   249,   356,   161,    21,   249,
+     343,   346,   347,   249,   249,   249,   249,   249,   249,   249,
+       5,   360,   162,   250,   257,   268,   349,   363,   364,     3,
+     351,    18,    21,    22,    23,   362,   360,   163,   163,     3,
+     163,   251,   251,   249,   163,   163,   163,   249,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   163,
+     251,   163,   251,   251,   251,   252,   366,   367,     3,     3,
+     126,     3,   251,   163,     3,     5,   249,   256,   249,   249,
+     249,   249,   249,   249,   249,   249,   249,   249,   249,   249,
+     249,   249,     5,    22,   249,   255,   249,     5,   249,     5,
+     249,   356,   272,   258,   263,   263,     3,   163,   245,   192,
+     163,     3,     3,   163,   162,   298,     5,     3,   373,   360,
+      21,    23,   162,   249,     3,   163,   163,   163,   163,     3,
+     373,     3,   163,     3,    22,     3,   163,   162,   160,   336,
+     238,   202,   207,   208,   253,   249,     3,   201,   160,   206,
+     202,   162,   162,   179,   305,   162,   182,   182,   249,   163,
+     222,   220,     4,    21,   246,   247,   248,   249,   220,   245,
+     245,   220,   218,   245,   162,     3,   131,   182,   160,   245,
+     230,     5,   238,   163,     3,   239,    21,   163,   245,    27,
+     160,   278,   279,   249,   285,   286,   287,   289,   292,   293,
+     282,    91,   115,   308,   309,   330,    83,   311,   312,   316,
+     112,   162,   326,   107,   322,   325,   172,   267,   161,   163,
+       3,   249,   163,   363,   254,   365,   365,   365,     3,   363,
+     360,   360,   360,   360,   360,   293,   249,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,   163,   163,   163,   163,
+     163,   163,   163,   163,   163,   163,     3,     3,     3,   249,
+     367,   249,   367,   249,   367,   163,   252,   249,   249,   249,
+     249,   249,   257,     4,     4,   249,   264,   265,   266,   163,
+     163,   267,   133,   160,   249,    35,    82,    88,   284,   249,
+     249,   121,   371,   163,   249,   266,   168,   245,   355,   371,
+     163,   267,   188,   249,   194,    22,     3,    19,    20,    21,
+     167,   268,   163,   160,   368,    22,   249,   249,   305,    21,
+     160,   163,   184,   185,    26,   177,   205,   249,     3,   163,
+       4,   267,    21,   233,   233,   217,   134,   135,   136,   243,
+     242,   245,   233,   163,   238,   239,   160,   163,     4,   122,
+       3,    36,   290,   295,   172,   172,   160,   162,    84,   312,
+     313,   314,   317,   172,     4,   249,   327,   328,   329,   160,
+     160,   299,   337,   347,     3,   163,   254,   364,   160,   368,
+     368,   368,   163,   272,     4,   249,     4,     3,   271,   245,
+     163,   162,   162,   163,     3,     5,   163,   356,   163,   202,
+     207,   207,   207,   207,     5,   163,   163,   163,     3,   163,
+     162,   183,   247,   248,   249,   162,   234,   249,   163,   233,
+       5,   122,   274,   239,   238,   160,   166,   280,   281,   160,
+     279,   294,    37,    38,   296,   297,   172,   249,   160,    85,
+     312,   318,   172,   299,   329,     3,   163,     4,   245,   368,
+     365,   163,   163,   163,   163,   249,     4,   249,   265,     3,
+     294,   249,   249,   257,   338,   249,    22,    82,   185,   163,
+     184,    21,   274,   249,   249,   122,     3,   163,   160,   160,
+     172,   288,   163,   160,   299,   328,   329,   245,   163,   249,
+       4,   249,   163,   163,     3,     3,   202,   163,   163,   160,
+     281,   160,   288,    82,   249,   249,   249,    22,   160,     3,
+     249
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  However,
+   YYFAIL appears to be in use.  Nevertheless, it is formally deprecated
+   in Bison 2.4.2's NEWS entry, where a plan to phase it out is
+   discussed.  */
+
+#define YYFAIL		goto yyerrlab
+#if defined YYFAIL
+  /* This is here to suppress warnings from the GCC cpp's
+     -Wunused-macros.  Normally we don't worry about that warning, but
+     some users do, and we want to make it easy for users to remove
+     YYFAIL uses, which will produce warnings from Bison 2.5.  */
+#endif
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)                                  \
+do                                                              \
+  if (yychar == YYEMPTY)                                        \
+    {                                                           \
+      yychar = (Token);                                         \
+      yylval = (Value);                                         \
+      YYPOPSTACK (yylen);                                       \
+      yystate = *yyssp;                                         \
+      goto yybackup;                                            \
+    }                                                           \
+  else                                                          \
+    {                                                           \
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+/* Error token number */
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* This macro is provided for backward compatibility. */
+#ifndef YY_LOCATION_PRINT
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  FILE *yyo = yyoutput;
+  YYUSE (yyo);
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+        break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
+#else
+static void
+yy_stack_print (yybottom, yytop)
+    yytype_int16 *yybottom;
+    yytype_int16 *yytop;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; yybottom <= yytop; yybottom++)
+    {
+      int yybot = *yybottom;
+      YYFPRINTF (stderr, " %d", yybot);
+    }
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      YYFPRINTF (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      YYFPRINTF (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
+   about the unexpected token YYTOKEN for the state stack whose top is
+   YYSSP.
+
+   Return 0 if *YYMSG was successfully written.  Return 1 if *YYMSG is
+   not large enough to hold the message.  In that case, also set
+   *YYMSG_ALLOC to the required number of bytes.  Return 2 if the
+   required number of bytes is too large to store.  */
+static int
+yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
+                yytype_int16 *yyssp, int yytoken)
+{
+  YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]);
+  YYSIZE_T yysize = yysize0;
+  enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+  /* Internationalized format string. */
+  const char *yyformat = YY_NULL;
+  /* Arguments of yyformat. */
+  char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+  /* Number of reported tokens (one for the "unexpected", one per
+     "expected"). */
+  int yycount = 0;
+
+  /* There are many possibilities here to consider:
+     - Assume YYFAIL is not used.  It's too flawed to consider.  See
+       <http://lists.gnu.org/archive/html/bison-patches/2009-12/msg00024.html>
+       for details.  YYERROR is fine as it does not invoke this
+       function.
+     - If this state is a consistent state with a default action, then
+       the only way this function was invoked is if the default action
+       is an error action.  In that case, don't check for expected
+       tokens because there are none.
+     - The only way there can be no lookahead present (in yychar) is if
+       this state is a consistent state with a default action.  Thus,
+       detecting the absence of a lookahead is sufficient to determine
+       that there is no unexpected or expected token to report.  In that
+       case, just report a simple "syntax error".
+     - Don't assume there isn't a lookahead just because this state is a
+       consistent state with a default action.  There might have been a
+       previous inconsistent state, consistent state with a non-default
+       action, or user semantic action that manipulated yychar.
+     - Of course, the expected token list depends on states to have
+       correct lookahead information, and it depends on the parser not
+       to perform extra reductions after fetching a lookahead from the
+       scanner and before detecting a syntax error.  Thus, state merging
+       (from LALR or IELR) and default reductions corrupt the expected
+       token list.  However, the list is correct for canonical LR with
+       one exception: it will still contain any token that will not be
+       accepted due to an error action in a later state.
+  */
+  if (yytoken != YYEMPTY)
+    {
+      int yyn = yypact[*yyssp];
+      yyarg[yycount++] = yytname[yytoken];
+      if (!yypact_value_is_default (yyn))
+        {
+          /* Start YYX at -YYN if negative to avoid negative indexes in
+             YYCHECK.  In other words, skip the first -YYN actions for
+             this state because they are default actions.  */
+          int yyxbegin = yyn < 0 ? -yyn : 0;
+          /* Stay within bounds of both yycheck and yytname.  */
+          int yychecklim = YYLAST - yyn + 1;
+          int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+          int yyx;
+
+          for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+            if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
+                && !yytable_value_is_error (yytable[yyx + yyn]))
+              {
+                if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+                  {
+                    yycount = 1;
+                    yysize = yysize0;
+                    break;
+                  }
+                yyarg[yycount++] = yytname[yyx];
+                {
+                  YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]);
+                  if (! (yysize <= yysize1
+                         && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+                    return 2;
+                  yysize = yysize1;
+                }
+              }
+        }
+    }
+
+  switch (yycount)
+    {
+# define YYCASE_(N, S)                      \
+      case N:                               \
+        yyformat = S;                       \
+      break
+      YYCASE_(0, YY_("syntax error"));
+      YYCASE_(1, YY_("syntax error, unexpected %s"));
+      YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
+      YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
+      YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
+      YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
+# undef YYCASE_
+    }
+
+  {
+    YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
+    if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+      return 2;
+    yysize = yysize1;
+  }
+
+  if (*yymsg_alloc < yysize)
+    {
+      *yymsg_alloc = 2 * yysize;
+      if (! (yysize <= *yymsg_alloc
+             && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
+        *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
+      return 1;
+    }
+
+  /* Avoid sprintf, as that infringes on the user's name space.
+     Don't have undefined behavior even if the translation
+     produced a string with the wrong number of "%s"s.  */
+  {
+    char *yyp = *yymsg;
+    int yyi = 0;
+    while ((*yyp = *yyformat) != '\0')
+      if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
+        {
+          yyp += yytnamerr (yyp, yyarg[yyi++]);
+          yyformat += 2;
+        }
+      else
+        {
+          yyp++;
+          yyformat++;
+        }
+  }
+  return 0;
+}
+#endif /* YYERROR_VERBOSE */
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+        break;
+    }
+}
+
+
+
+
+/* The lookahead symbol.  */
+int yychar;
+
+
+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END
+#endif
+#ifndef YY_INITIAL_VALUE
+# define YY_INITIAL_VALUE(Value) /* Nothing. */
+#endif
+
+/* The semantic value of the lookahead symbol.  */
+YYSTYPE yylval YY_INITIAL_VALUE(yyval_default);
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+    int yystate;
+    /* Number of tokens to shift before error messages enabled.  */
+    int yyerrstatus;
+
+    /* The stacks and their tools:
+       `yyss': related to states.
+       `yyvs': related to semantic values.
+
+       Refer to the stacks through separate pointers, to allow yyoverflow
+       to reallocate them elsewhere.  */
+
+    /* The state stack.  */
+    yytype_int16 yyssa[YYINITDEPTH];
+    yytype_int16 *yyss;
+    yytype_int16 *yyssp;
+
+    /* The semantic value stack.  */
+    YYSTYPE yyvsa[YYINITDEPTH];
+    YYSTYPE *yyvs;
+    YYSTYPE *yyvsp;
+
+    YYSIZE_T yystacksize;
+
+  int yyn;
+  int yyresult;
+  /* Lookahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  yyssp = yyss = yyssa;
+  yyvsp = yyvs = yyvsa;
+  yystacksize = YYINITDEPTH;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY; /* Cause a token to be read.  */
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss_alloc, yyss);
+	YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  if (yystate == YYFINAL)
+    YYACCEPT;
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     lookahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to lookahead token.  */
+  yyn = yypact[yystate];
+  if (yypact_value_is_default (yyn))
+    goto yydefault;
+
+  /* Not known => get a lookahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yytable_value_is_error (yyn))
+        goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the lookahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token.  */
+  yychar = YYEMPTY;
+
+  yystate = yyn;
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+  *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 7:
+/* Line 1807 of yacc.c  */
+#line 319 "fortran.y"
+    {yyerrok;yyclearin;}
+    break;
+
+  case 18:
+/* Line 1807 of yacc.c  */
+#line 337 "fortran.y"
+    {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
+    break;
+
+  case 20:
+/* Line 1807 of yacc.c  */
+#line 347 "fortran.y"
+    { pos_cur = setposcur(); }
+    break;
+
+  case 21:
+/* Line 1807 of yacc.c  */
+#line 350 "fortran.y"
+    { isrecursive = 0; }
+    break;
+
+  case 22:
+/* Line 1807 of yacc.c  */
+#line 351 "fortran.y"
+    { isrecursive = 1; }
+    break;
+
+  case 23:
+/* Line 1807 of yacc.c  */
+#line 354 "fortran.y"
+    { is_result_present = 0; }
+    break;
+
+  case 24:
+/* Line 1807 of yacc.c  */
+#line 355 "fortran.y"
+    { is_result_present = 1; }
+    break;
+
+  case 25:
+/* Line 1807 of yacc.c  */
+#line 359 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            if ( firstpass )
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l));
+            else
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 26:
+/* Line 1807 of yacc.c  */
+#line 367 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            inprogramdeclare = 1;
+            /* in the second step we should write the head of       */
+            /*    the subroutine sub_loop_<subroutinename>          */
+            if ( ! firstpass )
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 27:
+/* Line 1807 of yacc.c  */
+#line 376 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+            strcpy(DeclType, "");
+            /* we should to list of the subroutine argument the  */
+            /*    name of the function which has to be defined   */
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(4) - (5)].l));
+                if ( ! is_result_present )
+                    Add_FunctionType_Var_1((yyvsp[(3) - (5)].na));
+            }
+            else
+            /* in the second step we should write the head of    */
+            /*    the subroutine sub_loop_<subroutinename>       */
+                WriteBeginof_SubLoop();
+        }
+    break;
+
+  case 28:
+/* Line 1807 of yacc.c  */
+#line 393 "fortran.y"
+    {
+            GlobalDeclaration = 0;
+            strcpy(curmodulename,(yyvsp[(2) - (2)].na));
+            strcpy(subroutinename,"");
+            Add_NameOfModule_1((yyvsp[(2) - (2)].na));
+            if ( inmoduledeclare == 0 )
+            {
+                /* To know if there are in the module declaration    */
+                inmoduledeclare = 1;
+                /* to know if a module has been met                  */
+                inmodulemeet = 1;
+                /* to know if we are after the keyword contains      */
+                aftercontainsdeclare = 0 ;
+            }
+        }
+    break;
+
+  case 31:
+/* Line 1807 of yacc.c  */
+#line 415 "fortran.y"
+    { strcpy((yyval.na), (yyvsp[(1) - (1)].na)); strcpy(subroutinename, (yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 32:
+/* Line 1807 of yacc.c  */
+#line 417 "fortran.y"
+    { Add_Include_1((yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 33:
+/* Line 1807 of yacc.c  */
+#line 419 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 34:
+/* Line 1807 of yacc.c  */
+#line 420 "fortran.y"
+    { if ( firstpass ) (yyval.l)=NULL; }
+    break;
+
+  case 35:
+/* Line 1807 of yacc.c  */
+#line 421 "fortran.y"
+    { if ( firstpass ) (yyval.l)=(yyvsp[(2) - (3)].l); }
+    break;
+
+  case 38:
+/* Line 1807 of yacc.c  */
+#line 425 "fortran.y"
+    { if ( firstpass ) Add_SubroutineArgument_Var_1((yyvsp[(2) - (3)].l)); }
+    break;
+
+  case 39:
+/* Line 1807 of yacc.c  */
+#line 428 "fortran.y"
+    {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(1) - (1)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                curlistvar = insertvar(NULL,curvar);
+                (yyval.l) = settype("",curlistvar);
+            }
+        }
+    break;
+
+  case 40:
+/* Line 1807 of yacc.c  */
+#line 440 "fortran.y"
+    {
+            if ( firstpass == 1 )
+            {
+                strcpy(nameinttypenameback,nameinttypename);
+                strcpy(nameinttypename,"");
+                curvar = createvar((yyvsp[(3) - (3)].na),NULL);
+                strcpy(nameinttypename,nameinttypenameback);
+                (yyval.l) = insertvar((yyvsp[(1) - (3)].l),curvar);
+            }
+        }
+    break;
+
+  case 41:
+/* Line 1807 of yacc.c  */
+#line 451 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 42:
+/* Line 1807 of yacc.c  */
+#line 452 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 44:
+/* Line 1807 of yacc.c  */
+#line 455 "fortran.y"
+    { inside_type_declare = 1; }
+    break;
+
+  case 45:
+/* Line 1807 of yacc.c  */
+#line 456 "fortran.y"
+    { inside_type_declare = 0; }
+    break;
+
+  case 47:
+/* Line 1807 of yacc.c  */
+#line 459 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(3) - (4)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(3) - (4)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 48:
+/* Line 1807 of yacc.c  */
+#line 476 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    if ( insubroutinedeclare )  Add_Parameter_Var_1((yyvsp[(2) - (2)].l));
+                    else                        Add_GlobalParameter_Var_1((yyvsp[(2) - (2)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                }
+            }
+            VariableIsParameter =  0 ;
+        }
+    break;
+
+  case 50:
+/* Line 1807 of yacc.c  */
+#line 494 "fortran.y"
+    {
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
+        }
+    break;
+
+  case 52:
+/* Line 1807 of yacc.c  */
+#line 500 "fortran.y"
+    {
+            /* if the variable is a parameter we can suppose that is   */
+            /*    value is the same on each grid. It is not useless to */
+            /*    create a copy of it on each grid                     */
+            if ( ! inside_type_declare )
+            {
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (1)].l));
+                    /* if variableparamlists has been declared in a subroutine   */
+                    if ( insubroutinedeclare )     Add_Dimension_Var_1((yyvsp[(1) - (1)].l));
+                }
+                else
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
+                }
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+        }
+    break;
+
+  case 53:
+/* Line 1807 of yacc.c  */
+#line 537 "fortran.y"
+    {
+            if (firstpass == 0)
+            {
+                if ((yyvsp[(1) - (1)].lnn))
+                {
+                    removeglobfromlist(&((yyvsp[(1) - (1)].lnn)));
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
+                    writelistpublic((yyvsp[(1) - (1)].lnn));
+                }
+            }
+        }
+    break;
+
+  case 62:
+/* Line 1807 of yacc.c  */
+#line 558 "fortran.y"
+    {
+            /* we should remove the data declaration                */
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
+
+            if ( aftercontainsdeclare == 1  && firstpass == 0 )
+            {
+                ReWriteDataStatement_0(fortran_out);
+                pos_end = setposcur();
+            }
+        }
+    break;
+
+  case 64:
+/* Line 1807 of yacc.c  */
+#line 572 "fortran.y"
+    {
+            PublicDeclare = 0 ;
+            PrivateDeclare = 0 ;
+        }
+    break;
+
+  case 102:
+/* Line 1807 of yacc.c  */
+#line 630 "fortran.y"
+    {
+            /* if the variable is a parameter we can suppose that is*/
+            /*    value is the same on each grid. It is not useless */
+            /*    to create a copy of it on each grid               */
+            if ( ! inside_type_declare )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
+                ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(1) - (2)].l));
+                pos_cur_decl = setposcur();
+                if ( firstpass == 0 && GlobalDeclaration == 0
+                                    && insubroutinedeclare == 0 )
+                {
+                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
+                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
+                    module_declar = open_for_write(ligne);
+                    GlobalDeclaration = 1 ;
+                    pos_cur_decl = setposcur();
+                }
+                (yyval.l) = (yyvsp[(1) - (2)].l);
+
+                if ( firstpass )
+                {
+                    Add_Globliste_1((yyvsp[(1) - (2)].l));
+                    if ( insubroutinedeclare )
+                    {
+                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1((yyvsp[(1) - (2)].l));
+                        Add_Parameter_Var_1((yyvsp[(1) - (2)].l));
+                    }
+                    else
+                        Add_GlobalParameter_Var_1((yyvsp[(1) - (2)].l));
+
+                    /* If there's a SAVE declaration in module's subroutines we should    */
+                    /*    remove it from the subroutines declaration and add it in the    */
+                    /*    global declarations                                             */
+                    if ( aftercontainsdeclare && SaveDeclare )
+                    {
+                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1((yyvsp[(1) - (2)].l));
+                        else                Add_Save_Var_dcl_1((yyvsp[(1) - (2)].l));
+                    }
+                }
+            }
+            else
+            {
+                (yyval.l) = (listvar *) NULL;
+            }
+            PublicDeclare = 0;
+            PrivateDeclare = 0;
+            ExternalDeclare = 0;
+            strcpy(NamePrecision,"");
+            c_star = 0;
+            InitialValueGiven = 0 ;
+            strcpy(IntentSpec,"");
+            VariableIsParameter =  0 ;
+            Allocatabledeclare = 0 ;
+            Targetdeclare = 0 ;
+            SaveDeclare = 0;
+            pointerdeclare = 0;
+            optionaldeclare = 0 ;
+            dimsgiven=0;
+            c_selectorgiven=0;
+            strcpy(nameinttypename,"");
+            strcpy(c_selectorname,"");
+            GlobalDeclarationType = 0;
+        }
+    break;
+
+  case 103:
+/* Line 1807 of yacc.c  */
+#line 696 "fortran.y"
+    {
+            insubroutinedeclare = 1;
+
+            if ( firstpass )
+            {
+                Add_SubroutineArgument_Var_1((yyvsp[(3) - (3)].l));
+                Add_FunctionType_Var_1((yyvsp[(2) - (3)].na));
+            }
+            else
+                WriteBeginof_SubLoop();
+
+            strcpy(nameinttypename,"");
+        }
+    break;
+
+  case 104:
+/* Line 1807 of yacc.c  */
+#line 710 "fortran.y"
+    { functiondeclarationisdone = 1; }
+    break;
+
+  case 105:
+/* Line 1807 of yacc.c  */
+#line 712 "fortran.y"
+    { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+    break;
+
+  case 109:
+/* Line 1807 of yacc.c  */
+#line 724 "fortran.y"
+    {
+            createstringfromlistname(ligne,(yyvsp[(3) - (4)].lnn));
+            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,(yyvsp[(1) - (4)].na),ligne);
+            else                Add_Data_Var_1(&List_Data_Var_Cur,(yyvsp[(1) - (4)].na),ligne);
+        }
+    break;
+
+  case 110:
+/* Line 1807 of yacc.c  */
+#line 730 "fortran.y"
+    {
+            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].lnn),(yyvsp[(3) - (4)].lnn));
+        }
+    break;
+
+  case 111:
+/* Line 1807 of yacc.c  */
+#line 735 "fortran.y"
+    {
+            createstringfromlistname(ligne,(yyvsp[(7) - (8)].lnn));
+            printf("###################################################################################################################\n");
+            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
+            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
+                line_num_input,(yyvsp[(2) - (8)].na),(yyvsp[(4) - (8)].na),ligne);
+            printf("## But, are you SURE you NEED a DATA construct ?\n");
+            printf("###################################################################################################################\n");
+            exit(1);
+        }
+    break;
+
+  case 112:
+/* Line 1807 of yacc.c  */
+#line 748 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 113:
+/* Line 1807 of yacc.c  */
+#line 749 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(3) - (3)].lnn),(yyvsp[(1) - (3)].na),1);   }
+    break;
+
+  case 118:
+/* Line 1807 of yacc.c  */
+#line 758 "fortran.y"
+    { pos_cursave = setposcur()-4; }
+    break;
+
+  case 120:
+/* Line 1807 of yacc.c  */
+#line 761 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Save_Var_1((yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].d)); }
+    break;
+
+  case 121:
+/* Line 1807 of yacc.c  */
+#line 764 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 122:
+/* Line 1807 of yacc.c  */
+#line 765 "fortran.y"
+    { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
+    break;
+
+  case 123:
+/* Line 1807 of yacc.c  */
+#line 766 "fortran.y"
+    { (yyval.lnn) = concat_listname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].lnn)); }
+    break;
+
+  case 124:
+/* Line 1807 of yacc.c  */
+#line 769 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));  }
+    break;
+
+  case 125:
+/* Line 1807 of yacc.c  */
+#line 770 "fortran.y"
+    { sprintf((yyval.na),"%s+%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 126:
+/* Line 1807 of yacc.c  */
+#line 771 "fortran.y"
+    { sprintf((yyval.na),"%s-%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 127:
+/* Line 1807 of yacc.c  */
+#line 772 "fortran.y"
+    { sprintf((yyval.na),"%s*%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 128:
+/* Line 1807 of yacc.c  */
+#line 773 "fortran.y"
+    { sprintf((yyval.na),"%s/%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 129:
+/* Line 1807 of yacc.c  */
+#line 775 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 130:
+/* Line 1807 of yacc.c  */
+#line 776 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 135:
+/* Line 1807 of yacc.c  */
+#line 786 "fortran.y"
+    {
+            positioninblock = 0;
+            pos_curdimension = setposcur()-9;
+        }
+    break;
+
+  case 136:
+/* Line 1807 of yacc.c  */
+#line 793 "fortran.y"
+    {
+            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar=insertvar(NULL, curvar);
+            (yyval.l) = settype("",curlistvar);
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 137:
+/* Line 1807 of yacc.c  */
+#line 803 "fortran.y"
+    {
+            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,(yyvsp[(3) - (5)].na));
+            if ( inside_type_declare ) break;
+            curvar = createvar((yyvsp[(3) - (5)].na),(yyvsp[(4) - (5)].d));
+            CreateAndFillin_Curvar("", curvar);
+            curlistvar = insertvar((yyvsp[(1) - (5)].l), curvar);
+            (yyval.l) = curlistvar;
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 140:
+/* Line 1807 of yacc.c  */
+#line 818 "fortran.y"
+    { (yyval.lnn) = (listname *) NULL; }
+    break;
+
+  case 141:
+/* Line 1807 of yacc.c  */
+#line 819 "fortran.y"
+    { (yyval.lnn) = (yyvsp[(3) - (3)].lnn); }
+    break;
+
+  case 142:
+/* Line 1807 of yacc.c  */
+#line 822 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 143:
+/* Line 1807 of yacc.c  */
+#line 823 "fortran.y"
+    { (yyval.lnn) = Insertname(NULL,(yyvsp[(1) - (1)].na),0); }
+    break;
+
+  case 144:
+/* Line 1807 of yacc.c  */
+#line 824 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 145:
+/* Line 1807 of yacc.c  */
+#line 825 "fortran.y"
+    { (yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);   }
+    break;
+
+  case 146:
+/* Line 1807 of yacc.c  */
+#line 829 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 147:
+/* Line 1807 of yacc.c  */
+#line 835 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (3)].na));
+            Add_NameOfCommon_1((yyvsp[(2) - (3)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 148:
+/* Line 1807 of yacc.c  */
+#line 843 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            sprintf(charusemodule,"%s",(yyvsp[(3) - (5)].na));
+            Add_NameOfCommon_1((yyvsp[(3) - (5)].na),subroutinename);
+            pos_end = setposcur();
+            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
+        }
+    break;
+
+  case 149:
+/* Line 1807 of yacc.c  */
+#line 852 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6;   }
+    break;
+
+  case 150:
+/* Line 1807 of yacc.c  */
+#line 853 "fortran.y"
+    { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
+    break;
+
+  case 151:
+/* Line 1807 of yacc.c  */
+#line 856 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 152:
+/* Line 1807 of yacc.c  */
+#line 857 "fortran.y"
+    { if ( ! inside_type_declare ) Add_Common_var_1(); }
+    break;
+
+  case 153:
+/* Line 1807 of yacc.c  */
+#line 861 "fortran.y"
+    {
+            positioninblock = positioninblock + 1 ;
+            strcpy(commonvar,(yyvsp[(1) - (2)].na));
+            commondim = (yyvsp[(2) - (2)].d);
+        }
+    break;
+
+  case 154:
+/* Line 1807 of yacc.c  */
+#line 869 "fortran.y"
+    {
+            strcpy((yyval.na),"");
+            positioninblock=0;
+            strcpy(commonblockname,"");
+        }
+    break;
+
+  case 155:
+/* Line 1807 of yacc.c  */
+#line 875 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(2) - (3)].na));
+            positioninblock=0;
+            strcpy(commonblockname,(yyvsp[(2) - (3)].na));
+        }
+    break;
+
+  case 158:
+/* Line 1807 of yacc.c  */
+#line 885 "fortran.y"
+    { (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v)); }
+    break;
+
+  case 159:
+/* Line 1807 of yacc.c  */
+#line 886 "fortran.y"
+    { (yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));   }
+    break;
+
+  case 160:
+/* Line 1807 of yacc.c  */
+#line 890 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            curvar=(variable *) calloc(1,sizeof(variable));
+            Init_Variable(curvar);
+            curvar->v_VariableIsParameter = 1;
+            strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].na));
+            strcpy(curvar->v_subroutinename,subroutinename);
+            strcpy(curvar->v_modulename,curmodulename);
+            strcpy(curvar->v_initialvalue,(yyvsp[(3) - (3)].na));
+            strcpy(curvar->v_commoninfile,cur_filename);
+            Save_Length((yyvsp[(3) - (3)].na),14);
+            (yyval.v) = curvar;
+        }
+    break;
+
+  case 164:
+/* Line 1807 of yacc.c  */
+#line 913 "fortran.y"
+    {
+            if ( insubroutinedeclare == 1 )
+            {
+                Add_ImplicitNoneSubroutine_1();
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_end-13,13);
+            }
+        }
+    break;
+
+  case 166:
+/* Line 1807 of yacc.c  */
+#line 924 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(2) - (5)].na),curdim);
+                else                curvar = createvar((yyvsp[(2) - (5)].na),(yyvsp[(3) - (5)].d));
+                CreateAndFillin_Curvar(DeclType, curvar);
+                curlistvar = insertvar(NULL, curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=settype(DeclType,curlistvar);
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 167:
+/* Line 1807 of yacc.c  */
+#line 946 "fortran.y"
+    {
+            if ( ! inside_type_declare )
+            {
+                if (dimsgiven == 1) curvar = createvar((yyvsp[(3) - (6)].na), curdim);
+                else                curvar = createvar((yyvsp[(3) - (6)].na), (yyvsp[(4) - (6)].d));
+                CreateAndFillin_Curvar((yyvsp[(1) - (6)].l)->var->v_typevar,curvar);
+                strcpy(curvar->v_typevar, (yyvsp[(1) - (6)].l)->var->v_typevar);
+                curvar->v_catvar = get_cat_var(curvar);
+                curlistvar = insertvar((yyvsp[(1) - (6)].l), curvar);
+                if (!strcasecmp(DeclType,"character"))
+                {
+                    if (c_selectorgiven == 1)
+                    {
+                        strcpy(c_selectordim.first,"1");
+                        strcpy(c_selectordim.last,c_selectorname);
+                        Save_Length(c_selectorname,1);
+                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
+                    }
+                }
+                (yyval.l)=curlistvar;
+            }
+            strcpy(vallengspec,"");
+        }
+    break;
+
+  case 168:
+/* Line 1807 of yacc.c  */
+#line 970 "fortran.y"
+    { dimsgiven = 0; }
+    break;
+
+  case 169:
+/* Line 1807 of yacc.c  */
+#line 972 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (2)].na));  }
+    break;
+
+  case 170:
+/* Line 1807 of yacc.c  */
+#line 973 "fortran.y"
+    { strcpy(DeclType,"character");  }
+    break;
+
+  case 171:
+/* Line 1807 of yacc.c  */
+#line 974 "fortran.y"
+    { strcpy(DeclType,(yyvsp[(1) - (3)].na)); strcpy(nameinttypename,(yyvsp[(3) - (3)].na));  }
+    break;
+
+  case 172:
+/* Line 1807 of yacc.c  */
+#line 975 "fortran.y"
+    { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+    break;
+
+  case 174:
+/* Line 1807 of yacc.c  */
+#line 978 "fortran.y"
+    { c_selectorgiven = 1; strcpy(c_selectorname,(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 175:
+/* Line 1807 of yacc.c  */
+#line 979 "fortran.y"
+    { c_star = 1;}
+    break;
+
+  case 180:
+/* Line 1807 of yacc.c  */
+#line 987 "fortran.y"
+    { pos_cur_decl = setposcur()-9; }
+    break;
+
+  case 181:
+/* Line 1807 of yacc.c  */
+#line 990 "fortran.y"
+    { strcpy((yyval.na),"integer"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 182:
+/* Line 1807 of yacc.c  */
+#line 991 "fortran.y"
+    { strcpy((yyval.na),"logical"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 183:
+/* Line 1807 of yacc.c  */
+#line 992 "fortran.y"
+    { strcpy((yyval.na),"real");    pos_cur_decl = setposcur()-4; }
+    break;
+
+  case 184:
+/* Line 1807 of yacc.c  */
+#line 993 "fortran.y"
+    { strcpy((yyval.na),"complex"); pos_cur_decl = setposcur()-7; }
+    break;
+
+  case 185:
+/* Line 1807 of yacc.c  */
+#line 994 "fortran.y"
+    { strcpy((yyval.na),"double complex"); pos_cur_decl = setposcur()-14; }
+    break;
+
+  case 186:
+/* Line 1807 of yacc.c  */
+#line 995 "fortran.y"
+    { pos_cur_decl = setposcur()-16; strcpy((yyval.na),"real"); strcpy(nameinttypename,"8"); }
+    break;
+
+  case 188:
+/* Line 1807 of yacc.c  */
+#line 998 "fortran.y"
+    {strcpy(vallengspec,(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 189:
+/* Line 1807 of yacc.c  */
+#line 1001 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 190:
+/* Line 1807 of yacc.c  */
+#line 1002 "fortran.y"
+    { strcpy((yyval.na),"*(*)"); }
+    break;
+
+  case 197:
+/* Line 1807 of yacc.c  */
+#line 1014 "fortran.y"
+    {
+            if ( strstr((yyvsp[(3) - (3)].na),"0.d0") )
+            {
+                strcpy(nameinttypename,"8");
+                strcpy(NamePrecision,"");
+            }
+            else
+                sprintf(NamePrecision,"%s = %s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));
+        }
+    break;
+
+  case 198:
+/* Line 1807 of yacc.c  */
+#line 1023 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 199:
+/* Line 1807 of yacc.c  */
+#line 1024 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 200:
+/* Line 1807 of yacc.c  */
+#line 1025 "fortran.y"
+    { strcpy(NamePrecision,(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 201:
+/* Line 1807 of yacc.c  */
+#line 1028 "fortran.y"
+    { strcpy(CharacterSize,(yyvsp[(1) - (1)].na));  strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 202:
+/* Line 1807 of yacc.c  */
+#line 1029 "fortran.y"
+    { strcpy(CharacterSize,"*"); strcpy((yyval.na),"*"); }
+    break;
+
+  case 210:
+/* Line 1807 of yacc.c  */
+#line 1042 "fortran.y"
+    { VariableIsParameter = 1; }
+    break;
+
+  case 212:
+/* Line 1807 of yacc.c  */
+#line 1044 "fortran.y"
+    { Allocatabledeclare = 1; }
+    break;
+
+  case 213:
+/* Line 1807 of yacc.c  */
+#line 1045 "fortran.y"
+    { dimsgiven = 1; curdim = (yyvsp[(2) - (2)].d); }
+    break;
+
+  case 214:
+/* Line 1807 of yacc.c  */
+#line 1046 "fortran.y"
+    { ExternalDeclare = 1; }
+    break;
+
+  case 215:
+/* Line 1807 of yacc.c  */
+#line 1048 "fortran.y"
+    { strcpy(IntentSpec,(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 217:
+/* Line 1807 of yacc.c  */
+#line 1050 "fortran.y"
+    { optionaldeclare = 1 ; }
+    break;
+
+  case 218:
+/* Line 1807 of yacc.c  */
+#line 1051 "fortran.y"
+    { pointerdeclare = 1 ; }
+    break;
+
+  case 219:
+/* Line 1807 of yacc.c  */
+#line 1052 "fortran.y"
+    { SaveDeclare = 1 ; }
+    break;
+
+  case 220:
+/* Line 1807 of yacc.c  */
+#line 1053 "fortran.y"
+    { Targetdeclare = 1; }
+    break;
+
+  case 221:
+/* Line 1807 of yacc.c  */
+#line 1056 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 222:
+/* Line 1807 of yacc.c  */
+#line 1057 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 223:
+/* Line 1807 of yacc.c  */
+#line 1058 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 224:
+/* Line 1807 of yacc.c  */
+#line 1061 "fortran.y"
+    { PublicDeclare = 1;  }
+    break;
+
+  case 225:
+/* Line 1807 of yacc.c  */
+#line 1062 "fortran.y"
+    { PrivateDeclare = 1; }
+    break;
+
+  case 226:
+/* Line 1807 of yacc.c  */
+#line 1064 "fortran.y"
+    { (yyval.d) = (listdim*) NULL; }
+    break;
+
+  case 227:
+/* Line 1807 of yacc.c  */
+#line 1066 "fortran.y"
+    {
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=(yyvsp[(2) - (3)].d);
+        }
+    break;
+
+  case 228:
+/* Line 1807 of yacc.c  */
+#line 1074 "fortran.y"
+    {
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1));
+        }
+    break;
+
+  case 229:
+/* Line 1807 of yacc.c  */
+#line 1080 "fortran.y"
+    {
+            (yyval.d) = (listdim*) NULL;
+            if ( inside_type_declare ) break;
+            if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1));
+        }
+    break;
+
+  case 230:
+/* Line 1807 of yacc.c  */
+#line 1086 "fortran.y"
+    { strcpy((yyval.dim1).first,"1"); strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na)); Save_Length((yyvsp[(1) - (1)].na),1); }
+    break;
+
+  case 231:
+/* Line 1807 of yacc.c  */
+#line 1087 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,"");                    }
+    break;
+
+  case 232:
+/* Line 1807 of yacc.c  */
+#line 1088 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na));  Save_Length((yyvsp[(1) - (2)].na),2); strcpy((yyval.dim1).last,""); }
+    break;
+
+  case 233:
+/* Line 1807 of yacc.c  */
+#line 1089 "fortran.y"
+    { strcpy((yyval.dim1).first,"");  strcpy((yyval.dim1).last,(yyvsp[(2) - (2)].na)); Save_Length((yyvsp[(2) - (2)].na),1); }
+    break;
+
+  case 234:
+/* Line 1807 of yacc.c  */
+#line 1090 "fortran.y"
+    { strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na));  Save_Length((yyvsp[(1) - (3)].na),2); strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na)); Save_Length((yyvsp[(3) - (3)].na),1); }
+    break;
+
+  case 235:
+/* Line 1807 of yacc.c  */
+#line 1093 "fortran.y"
+    { strcpy((yyval.na),"*"); }
+    break;
+
+  case 236:
+/* Line 1807 of yacc.c  */
+#line 1094 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));  }
+    break;
+
+  case 237:
+/* Line 1807 of yacc.c  */
+#line 1096 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 238:
+/* Line 1807 of yacc.c  */
+#line 1097 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 239:
+/* Line 1807 of yacc.c  */
+#line 1098 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 240:
+/* Line 1807 of yacc.c  */
+#line 1099 "fortran.y"
+    { sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 241:
+/* Line 1807 of yacc.c  */
+#line 1103 "fortran.y"
+    { sprintf((yyval.na),"SUM(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 242:
+/* Line 1807 of yacc.c  */
+#line 1104 "fortran.y"
+    { sprintf((yyval.na),"MAX(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 243:
+/* Line 1807 of yacc.c  */
+#line 1105 "fortran.y"
+    { sprintf((yyval.na),"TANH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 244:
+/* Line 1807 of yacc.c  */
+#line 1106 "fortran.y"
+    { sprintf((yyval.na),"MAXVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 245:
+/* Line 1807 of yacc.c  */
+#line 1107 "fortran.y"
+    { sprintf((yyval.na),"MIN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 246:
+/* Line 1807 of yacc.c  */
+#line 1108 "fortran.y"
+    { sprintf((yyval.na),"MINVAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 247:
+/* Line 1807 of yacc.c  */
+#line 1109 "fortran.y"
+    { sprintf((yyval.na),"TRIM(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 248:
+/* Line 1807 of yacc.c  */
+#line 1110 "fortran.y"
+    { sprintf((yyval.na),"SQRT(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 249:
+/* Line 1807 of yacc.c  */
+#line 1111 "fortran.y"
+    { sprintf((yyval.na),"REAL(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 250:
+/* Line 1807 of yacc.c  */
+#line 1112 "fortran.y"
+    { sprintf((yyval.na),"NINT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 251:
+/* Line 1807 of yacc.c  */
+#line 1113 "fortran.y"
+    { sprintf((yyval.na),"FLOAT(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 252:
+/* Line 1807 of yacc.c  */
+#line 1114 "fortran.y"
+    { sprintf((yyval.na),"EXP(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 253:
+/* Line 1807 of yacc.c  */
+#line 1115 "fortran.y"
+    { sprintf((yyval.na),"COS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 254:
+/* Line 1807 of yacc.c  */
+#line 1116 "fortran.y"
+    { sprintf((yyval.na),"COSH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 255:
+/* Line 1807 of yacc.c  */
+#line 1117 "fortran.y"
+    { sprintf((yyval.na),"ACOS(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 256:
+/* Line 1807 of yacc.c  */
+#line 1118 "fortran.y"
+    { sprintf((yyval.na),"SIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 257:
+/* Line 1807 of yacc.c  */
+#line 1119 "fortran.y"
+    { sprintf((yyval.na),"SINH(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 258:
+/* Line 1807 of yacc.c  */
+#line 1120 "fortran.y"
+    { sprintf((yyval.na),"ASIN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 259:
+/* Line 1807 of yacc.c  */
+#line 1121 "fortran.y"
+    { sprintf((yyval.na),"LOG(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 260:
+/* Line 1807 of yacc.c  */
+#line 1122 "fortran.y"
+    { sprintf((yyval.na),"TAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 261:
+/* Line 1807 of yacc.c  */
+#line 1123 "fortran.y"
+    { sprintf((yyval.na),"ATAN(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 262:
+/* Line 1807 of yacc.c  */
+#line 1124 "fortran.y"
+    { sprintf((yyval.na),"ABS(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 263:
+/* Line 1807 of yacc.c  */
+#line 1125 "fortran.y"
+    { sprintf((yyval.na),"MOD(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 264:
+/* Line 1807 of yacc.c  */
+#line 1126 "fortran.y"
+    { sprintf((yyval.na),"SIGN(%s)",(yyvsp[(2) - (3)].na));}
+    break;
+
+  case 265:
+/* Line 1807 of yacc.c  */
+#line 1127 "fortran.y"
+    { sprintf((yyval.na),"MINLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 266:
+/* Line 1807 of yacc.c  */
+#line 1128 "fortran.y"
+    { sprintf((yyval.na),"MAXLOC(%s)",(yyvsp[(3) - (4)].na));}
+    break;
+
+  case 267:
+/* Line 1807 of yacc.c  */
+#line 1130 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 268:
+/* Line 1807 of yacc.c  */
+#line 1131 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 269:
+/* Line 1807 of yacc.c  */
+#line 1133 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 270:
+/* Line 1807 of yacc.c  */
+#line 1134 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 271:
+/* Line 1807 of yacc.c  */
+#line 1135 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 272:
+/* Line 1807 of yacc.c  */
+#line 1136 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 273:
+/* Line 1807 of yacc.c  */
+#line 1137 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 274:
+/* Line 1807 of yacc.c  */
+#line 1138 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 275:
+/* Line 1807 of yacc.c  */
+#line 1140 "fortran.y"
+    { strcpy((yyval.na),"+"); }
+    break;
+
+  case 276:
+/* Line 1807 of yacc.c  */
+#line 1141 "fortran.y"
+    { strcpy((yyval.na),"-"); }
+    break;
+
+  case 277:
+/* Line 1807 of yacc.c  */
+#line 1145 "fortran.y"
+    { sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 278:
+/* Line 1807 of yacc.c  */
+#line 1146 "fortran.y"
+    { sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 279:
+/* Line 1807 of yacc.c  */
+#line 1147 "fortran.y"
+    { sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 280:
+/* Line 1807 of yacc.c  */
+#line 1148 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 281:
+/* Line 1807 of yacc.c  */
+#line 1149 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 282:
+/* Line 1807 of yacc.c  */
+#line 1150 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 283:
+/* Line 1807 of yacc.c  */
+#line 1151 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 284:
+/* Line 1807 of yacc.c  */
+#line 1152 "fortran.y"
+    { sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 285:
+/* Line 1807 of yacc.c  */
+#line 1153 "fortran.y"
+    { sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 286:
+/* Line 1807 of yacc.c  */
+#line 1154 "fortran.y"
+    { sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 287:
+/* Line 1807 of yacc.c  */
+#line 1155 "fortran.y"
+    { sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 288:
+/* Line 1807 of yacc.c  */
+#line 1156 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 289:
+/* Line 1807 of yacc.c  */
+#line 1157 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 290:
+/* Line 1807 of yacc.c  */
+#line 1158 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 291:
+/* Line 1807 of yacc.c  */
+#line 1159 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 292:
+/* Line 1807 of yacc.c  */
+#line 1160 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 293:
+/* Line 1807 of yacc.c  */
+#line 1161 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 294:
+/* Line 1807 of yacc.c  */
+#line 1162 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 295:
+/* Line 1807 of yacc.c  */
+#line 1163 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 296:
+/* Line 1807 of yacc.c  */
+#line 1164 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 297:
+/* Line 1807 of yacc.c  */
+#line 1165 "fortran.y"
+    { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 298:
+/* Line 1807 of yacc.c  */
+#line 1167 "fortran.y"
+    { strcpy((yyval.na),""); }
+    break;
+
+  case 299:
+/* Line 1807 of yacc.c  */
+#line 1168 "fortran.y"
+    { sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 300:
+/* Line 1807 of yacc.c  */
+#line 1169 "fortran.y"
+    { sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 301:
+/* Line 1807 of yacc.c  */
+#line 1170 "fortran.y"
+    { sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 302:
+/* Line 1807 of yacc.c  */
+#line 1173 "fortran.y"
+    { sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 303:
+/* Line 1807 of yacc.c  */
+#line 1174 "fortran.y"
+    { sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 304:
+/* Line 1807 of yacc.c  */
+#line 1177 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 305:
+/* Line 1807 of yacc.c  */
+#line 1178 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 306:
+/* Line 1807 of yacc.c  */
+#line 1179 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 307:
+/* Line 1807 of yacc.c  */
+#line 1183 "fortran.y"
+    {
+            agrif_parentcall = 0;
+            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
+            if ( Agrif_in_Tok_NAME(identcopy) )
+            {
+                inagrifcallargument = 1;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 308:
+/* Line 1807 of yacc.c  */
+#line 1194 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
+    break;
+
+  case 309:
+/* Line 1807 of yacc.c  */
+#line 1195 "fortran.y"
+    { sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 310:
+/* Line 1807 of yacc.c  */
+#line 1196 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na)); }
+    break;
+
+  case 311:
+/* Line 1807 of yacc.c  */
+#line 1197 "fortran.y"
+    { sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na)); }
+    break;
+
+  case 312:
+/* Line 1807 of yacc.c  */
+#line 1201 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));
+            ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].na));
+            agrif_parentcall = 0;
+        }
+    break;
+
+  case 313:
+/* Line 1807 of yacc.c  */
+#line 1210 "fortran.y"
+    {
+            sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (4)].na),(yyvsp[(4) - (4)].na));
+            if ( incalldeclare == 0 ) inagrifcallargument = 0;
+        }
+    break;
+
+  case 314:
+/* Line 1807 of yacc.c  */
+#line 1216 "fortran.y"
+    { sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na)); }
+    break;
+
+  case 315:
+/* Line 1807 of yacc.c  */
+#line 1219 "fortran.y"
+    { strcpy((yyval.na)," "); }
+    break;
+
+  case 316:
+/* Line 1807 of yacc.c  */
+#line 1220 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 317:
+/* Line 1807 of yacc.c  */
+#line 1223 "fortran.y"
+    {  strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 318:
+/* Line 1807 of yacc.c  */
+#line 1224 "fortran.y"
+    {  sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 319:
+/* Line 1807 of yacc.c  */
+#line 1227 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 320:
+/* Line 1807 of yacc.c  */
+#line 1228 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 321:
+/* Line 1807 of yacc.c  */
+#line 1231 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 322:
+/* Line 1807 of yacc.c  */
+#line 1232 "fortran.y"
+    {  sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 323:
+/* Line 1807 of yacc.c  */
+#line 1233 "fortran.y"
+    {  sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));}
+    break;
+
+  case 324:
+/* Line 1807 of yacc.c  */
+#line 1234 "fortran.y"
+    {  sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));}
+    break;
+
+  case 325:
+/* Line 1807 of yacc.c  */
+#line 1235 "fortran.y"
+    {  sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));}
+    break;
+
+  case 326:
+/* Line 1807 of yacc.c  */
+#line 1236 "fortran.y"
+    {  sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));}
+    break;
+
+  case 327:
+/* Line 1807 of yacc.c  */
+#line 1237 "fortran.y"
+    {  sprintf((yyval.na),":");}
+    break;
+
+  case 328:
+/* Line 1807 of yacc.c  */
+#line 1240 "fortran.y"
+    {
+            if ( afterpercent == 0 )
+            {
+                if ( Agrif_in_Tok_NAME((yyvsp[(1) - (1)].na)) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+                if ( !strcasecmp((yyvsp[(1) - (1)].na),"Agrif_Parent") )   agrif_parentcall = 1;
+                if ( VariableIsFunction((yyvsp[(1) - (1)].na)) )
+                {
+                    if ( inagrifcallargument == 1 )
+                    {
+                        if ( !strcasecmp((yyvsp[(1) - (1)].na),identcopy) )
+                        {
+                            strcpy(sameagrifname,identcopy);
+                            sameagrifargument = 1;
+                        }
+                    }
+                    strcpy(identcopy,(yyvsp[(1) - (1)].na));
+                    pointedvar = 0;
+
+                    if (variscoupled_0((yyvsp[(1) - (1)].na))) strcpy(truename, getcoupledname_0((yyvsp[(1) - (1)].na)));
+                    else                    strcpy(truename, (yyvsp[(1) - (1)].na));
+
+                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
+                    {
+                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
+                        {
+                            if ( (IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].na)) == 1) || (inagrifcallargument == 1) )
+                            {
+                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].na)));
+                            }
+                        }
+                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
+                        {
+                            Add_UsedInSubroutine_Var_1(truename);
+                        }
+                    }
+                    NotifyAgrifFunction_0(truename);
+                }
+            }
+            else
+            {
+                afterpercent = 0;
+            }
+        }
+    break;
+
+  case 329:
+/* Line 1807 of yacc.c  */
+#line 1285 "fortran.y"
+    { strcpy((yyval.na),".TRUE.");}
+    break;
+
+  case 330:
+/* Line 1807 of yacc.c  */
+#line 1286 "fortran.y"
+    { strcpy((yyval.na),".FALSE.");}
+    break;
+
+  case 331:
+/* Line 1807 of yacc.c  */
+#line 1287 "fortran.y"
+    { strcpy((yyval.na),"NULL()"); }
+    break;
+
+  case 332:
+/* Line 1807 of yacc.c  */
+#line 1288 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 333:
+/* Line 1807 of yacc.c  */
+#line 1289 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 334:
+/* Line 1807 of yacc.c  */
+#line 1290 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 335:
+/* Line 1807 of yacc.c  */
+#line 1292 "fortran.y"
+    { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); }
+    break;
+
+  case 337:
+/* Line 1807 of yacc.c  */
+#line 1296 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 339:
+/* Line 1807 of yacc.c  */
+#line 1298 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 340:
+/* Line 1807 of yacc.c  */
+#line 1299 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 341:
+/* Line 1807 of yacc.c  */
+#line 1301 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 342:
+/* Line 1807 of yacc.c  */
+#line 1302 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 343:
+/* Line 1807 of yacc.c  */
+#line 1305 "fortran.y"
+    { sprintf((yyval.na),"(%s :%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));}
+    break;
+
+  case 344:
+/* Line 1807 of yacc.c  */
+#line 1307 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 345:
+/* Line 1807 of yacc.c  */
+#line 1308 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 346:
+/* Line 1807 of yacc.c  */
+#line 1311 "fortran.y"
+    { strcpy((yyval.na)," ");}
+    break;
+
+  case 347:
+/* Line 1807 of yacc.c  */
+#line 1312 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 348:
+/* Line 1807 of yacc.c  */
+#line 1314 "fortran.y"
+    { InitialValueGiven = 0; }
+    break;
+
+  case 349:
+/* Line 1807 of yacc.c  */
+#line 1316 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 1;
+        }
+    break;
+
+  case 350:
+/* Line 1807 of yacc.c  */
+#line 1322 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            strcpy(InitValue,(yyvsp[(2) - (2)].na));
+            InitialValueGiven = 2;
+        }
+    break;
+
+  case 351:
+/* Line 1807 of yacc.c  */
+#line 1329 "fortran.y"
+    {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 352:
+/* Line 1807 of yacc.c  */
+#line 1333 "fortran.y"
+    {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule, "%s", (yyvsp[(2) - (2)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (2)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuse_0((yyvsp[(2) - (2)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 353:
+/* Line 1807 of yacc.c  */
+#line 1353 "fortran.y"
+    {
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].lc));
+                    coupletmp = (yyvsp[(4) - (4)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne, coupletmp->c_namevar);
+                        strcat(ligne, " => ");
+                        strcat(ligne, coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (4)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (4)].na));
+            }
+            if ( inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+            }
+        }
+    break;
+
+  case 354:
+/* Line 1807 of yacc.c  */
+#line 1380 "fortran.y"
+    {
+            /* if variables has been declared in a subroutine       */
+            sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+            if ( firstpass )
+            {
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else
+            {
+                if ( insubroutinedeclare )
+                    copyuseonly_0((yyvsp[(2) - (6)].na));
+
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 355:
+/* Line 1807 of yacc.c  */
+#line 1400 "fortran.y"
+    {
+            /* if variables has been declared in a subroutine      */
+            if ( firstpass )
+            {
+                if ( insubroutinedeclare )
+                {
+                    Add_CouplePointed_Var_1((yyvsp[(2) - (6)].na),(yyvsp[(6) - (6)].lc));
+                    coupletmp = (yyvsp[(6) - (6)].lc);
+                    strcpy(ligne,"");
+                    while ( coupletmp )
+                    {
+                        strcat(ligne,coupletmp->c_namevar);
+                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
+                        strcat(ligne,coupletmp->c_namepointedvar);
+                        coupletmp = coupletmp->suiv;
+                        if ( coupletmp ) strcat(ligne,",");
+                    }
+                    sprintf(charusemodule,"%s",(yyvsp[(2) - (6)].na));
+                }
+                Add_NameOfModuleUsed_1((yyvsp[(2) - (6)].na));
+            }
+            else /* if ( firstpass == 0 ) */
+            {
+                if ( inmoduledeclare == 0 )
+                {
+                    pos_end = setposcur();
+                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
+                    if (oldfortran_out)  variableisglobalinmodule((yyvsp[(6) - (6)].lc),(yyvsp[(2) - (6)].na),oldfortran_out,pos_curuseold);
+                }
+                else
+                {
+                    /* if we are in the module declare and if the    */
+                    /* onlylist is a list of global variable         */
+                    variableisglobalinmodule((yyvsp[(6) - (6)].lc), (yyvsp[(2) - (6)].na), fortran_out,pos_curuse);
+                }
+            }
+        }
+    break;
+
+  case 356:
+/* Line 1807 of yacc.c  */
+#line 1440 "fortran.y"
+    {
+            pos_curuse = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
+        }
+    break;
+
+  case 357:
+/* Line 1807 of yacc.c  */
+#line 1447 "fortran.y"
+    {
+            (yyval.lc) = (yyvsp[(1) - (1)].lc);
+        }
+    break;
+
+  case 358:
+/* Line 1807 of yacc.c  */
+#line 1451 "fortran.y"
+    {
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 359:
+/* Line 1807 of yacc.c  */
+#line 1458 "fortran.y"
+    {
+            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 360:
+/* Line 1807 of yacc.c  */
+#line 1467 "fortran.y"
+    {  (yyval.lc) = (yyvsp[(1) - (1)].lc); }
+    break;
+
+  case 361:
+/* Line 1807 of yacc.c  */
+#line 1469 "fortran.y"
+    {
+            /* insert the variable in the list $1                 */
+            (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc);
+            (yyval.lc) = (yyvsp[(3) - (3)].lc);
+        }
+    break;
+
+  case 362:
+/* Line 1807 of yacc.c  */
+#line 1477 "fortran.y"
+    {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na));
+            strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na));
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1((yyvsp[(1) - (3)].na));
+        }
+    break;
+
+  case 363:
+/* Line 1807 of yacc.c  */
+#line 1487 "fortran.y"
+    {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].na));
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            (yyval.lc) = coupletmp;
+        }
+    break;
+
+  case 380:
+/* Line 1807 of yacc.c  */
+#line 1522 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 381:
+/* Line 1807 of yacc.c  */
+#line 1523 "fortran.y"
+    { inallocate = 0; }
+    break;
+
+  case 388:
+/* Line 1807 of yacc.c  */
+#line 1531 "fortran.y"
+    {
+            GlobalDeclaration = 0 ;
+            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
+            {
+                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
+            }
+            if ( strcasecmp(subroutinename,"") )
+            {
+                if ( inmodulemeet == 1 )
+                {
+                    /* we are in a module                                */
+                    if ( insubroutinedeclare == 1 )
+                    {
+                        /* it is like an end subroutine <name>            */
+                        insubroutinedeclare = 0 ;
+                        pos_cur = setposcur();
+                        closeandcallsubloopandincludeit_0(1);
+                        functiondeclarationisdone = 0;
+                    }
+                    else
+                    {
+                        /* it is like an end module <name>                */
+                        inmoduledeclare = 0 ;
+                        inmodulemeet = 0 ;
+                    }
+                }
+                else
+                {
+                    insubroutinedeclare = 0;
+                    pos_cur = setposcur();
+                    closeandcallsubloopandincludeit_0(2);
+                    functiondeclarationisdone = 0;
+                }
+            }
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 389:
+/* Line 1807 of yacc.c  */
+#line 1568 "fortran.y"
+    {
+            insubroutinedeclare = 0;
+            inprogramdeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(3);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 390:
+/* Line 1807 of yacc.c  */
+#line 1577 "fortran.y"
+    {
+            if ( strcasecmp(subroutinename,"") )
+            {
+                insubroutinedeclare = 0;
+                pos_cur = setposcur();
+                closeandcallsubloopandincludeit_0(1);
+                functiondeclarationisdone = 0;
+                strcpy(subroutinename,"");
+            }
+        }
+    break;
+
+  case 391:
+/* Line 1807 of yacc.c  */
+#line 1588 "fortran.y"
+    {
+            insubroutinedeclare = 0;
+            pos_cur = setposcur();
+            closeandcallsubloopandincludeit_0(0);
+            functiondeclarationisdone = 0;
+            strcpy(subroutinename,"");
+        }
+    break;
+
+  case 392:
+/* Line 1807 of yacc.c  */
+#line 1596 "fortran.y"
+    {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen((yyvsp[(2) - (2)].na))+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+    break;
+
+  case 395:
+/* Line 1807 of yacc.c  */
+#line 1620 "fortran.y"
+    {
+            if ( inside_type_declare ) break;
+            if ( inmoduledeclare )
+            {
+                if ( firstpass == 0 )
+                {
+                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
+                    Write_Closing_Module(0);
+                }
+                inmoduledeclare = 0 ;
+                aftercontainsdeclare = 1;
+            }
+            else if ( insubroutinedeclare )
+            {
+                incontainssubroutine = 1;
+                insubroutinedeclare  = 0;
+                incontainssubroutine = 0;
+                functiondeclarationisdone = 0;
+
+                if ( firstpass )
+                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
+                else
+                    closeandcallsubloop_contains_0();
+
+                strcpy(subroutinename, "");
+            }
+            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
+        }
+    break;
+
+  case 483:
+/* Line 1807 of yacc.c  */
+#line 1898 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+            functiondeclarationisdone = 0;
+        }
+    break;
+
+  case 484:
+/* Line 1807 of yacc.c  */
+#line 1906 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 485:
+/* Line 1807 of yacc.c  */
+#line 1913 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 486:
+/* Line 1807 of yacc.c  */
+#line 1920 "fortran.y"
+    {
+            strcpy((yyval.na),(yyvsp[(1) - (1)].na));
+            pos_endsubroutine = setposcur()-strlen((yyvsp[(1) - (1)].na));
+        }
+    break;
+
+  case 487:
+/* Line 1807 of yacc.c  */
+#line 1926 "fortran.y"
+    {strcpy((yyval.na),"");}
+    break;
+
+  case 488:
+/* Line 1807 of yacc.c  */
+#line 1927 "fortran.y"
+    {strcpy((yyval.na),(yyvsp[(1) - (1)].na));}
+    break;
+
+  case 489:
+/* Line 1807 of yacc.c  */
+#line 1930 "fortran.y"
+    { created_dimensionlist = 0; }
+    break;
+
+  case 490:
+/* Line 1807 of yacc.c  */
+#line 1934 "fortran.y"
+    {
+            created_dimensionlist = 1;
+            if ( ((yyvsp[(3) - (4)].d) == NULL) || ((yyvsp[(4) - (4)].d) == NULL) ) break;
+            if  ( agrif_parentcall == 1 )
+            {
+                ModifyTheAgrifFunction_0((yyvsp[(3) - (4)].d)->dim.last);
+                agrif_parentcall = 0;
+                fprintf(fortran_out," = ");
+            }
+        }
+    break;
+
+  case 491:
+/* Line 1807 of yacc.c  */
+#line 1945 "fortran.y"
+    {
+            created_dimensionlist = 1;
+        }
+    break;
+
+  case 496:
+/* Line 1807 of yacc.c  */
+#line 1958 "fortran.y"
+    {
+            inagrifcallargument = 0 ;
+            incalldeclare=0;
+            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
+                strcpy(subofagrifinitgrids,subroutinename);
+            }
+            Instanciation_0(sameagrifname);
+        }
+    break;
+
+  case 502:
+/* Line 1807 of yacc.c  */
+#line 1979 "fortran.y"
+    {
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"MPI_Init") )    callmpiinit = 1;
+            else                                callmpiinit = 0;
+
+            if (!strcasecmp((yyvsp[(2) - (2)].na),"Agrif_Init_Grids") )
+            {
+                callagrifinitgrids = 1;
+                strcpy(meetagrifinitgrids,subroutinename);
+            }
+            else
+            {
+                callagrifinitgrids = 0;
+            }
+            if ( Vartonumber((yyvsp[(2) - (2)].na)) == 1 )
+            {
+                incalldeclare = 1;
+                inagrifcallargument = 1 ;
+                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
+            }
+        }
+    break;
+
+  case 503:
+/* Line 1807 of yacc.c  */
+#line 2000 "fortran.y"
+    { pos_curcall=setposcur()-4; }
+    break;
+
+  case 506:
+/* Line 1807 of yacc.c  */
+#line 2008 "fortran.y"
+    {
+            if ( callmpiinit == 1 )
+            {
+                strcpy(mpiinitvar,(yyvsp[(1) - (1)].na));
+                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
+            }
+        }
+    break;
+
+  case 532:
+/* Line 1807 of yacc.c  */
+#line 2056 "fortran.y"
+    { afterpercent = 1; }
+    break;
+
+  case 572:
+/* Line 1807 of yacc.c  */
+#line 2115 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 573:
+/* Line 1807 of yacc.c  */
+#line 2116 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 574:
+/* Line 1807 of yacc.c  */
+#line 2117 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 575:
+/* Line 1807 of yacc.c  */
+#line 2118 "fortran.y"
+    { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); }
+    break;
+
+  case 576:
+/* Line 1807 of yacc.c  */
+#line 2119 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 577:
+/* Line 1807 of yacc.c  */
+#line 2120 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 578:
+/* Line 1807 of yacc.c  */
+#line 2121 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 579:
+/* Line 1807 of yacc.c  */
+#line 2122 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 580:
+/* Line 1807 of yacc.c  */
+#line 2123 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 581:
+/* Line 1807 of yacc.c  */
+#line 2124 "fortran.y"
+    { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); }
+    break;
+
+  case 582:
+/* Line 1807 of yacc.c  */
+#line 2127 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 583:
+/* Line 1807 of yacc.c  */
+#line 2128 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 584:
+/* Line 1807 of yacc.c  */
+#line 2129 "fortran.y"
+    { sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na)); }
+    break;
+
+  case 585:
+/* Line 1807 of yacc.c  */
+#line 2131 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s)",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));}
+    break;
+
+  case 586:
+/* Line 1807 of yacc.c  */
+#line 2132 "fortran.y"
+    { sprintf((yyval.na),"%s=%s,%s,%s)",(yyvsp[(1) - (7)].na),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));}
+    break;
+
+  case 591:
+/* Line 1807 of yacc.c  */
+#line 2142 "fortran.y"
+    { Add_Allocate_Var_1((yyvsp[(1) - (1)].na),curmodulename); }
+    break;
+
+
+/* Line 1807 of yacc.c  */
+#line 6110 "fortran.tab.c"
+      default: break;
+    }
+  /* User semantic actions sometimes alter yychar, and that requires
+     that yytoken be updated with the new translation.  We take the
+     approach of translating immediately before every use of yytoken.
+     One alternative is translating here after every semantic action,
+     but that translation would be missed if the semantic action invokes
+     YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
+     if it invokes YYBACKUP.  In the case of YYABORT or YYACCEPT, an
+     incorrect destructor might then be invoked immediately.  In the
+     case of YYERROR or YYBACKUP, subsequent parser actions might lead
+     to an incorrect destructor call or verbose syntax error message
+     before the lookahead is translated.  */
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* Make sure we have latest lookahead translation.  See comments at
+     user semantic actions for why this is necessary.  */
+  yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
+
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
+                                        yyssp, yytoken)
+      {
+        char const *yymsgp = YY_("syntax error");
+        int yysyntax_error_status;
+        yysyntax_error_status = YYSYNTAX_ERROR;
+        if (yysyntax_error_status == 0)
+          yymsgp = yymsg;
+        else if (yysyntax_error_status == 1)
+          {
+            if (yymsg != yymsgbuf)
+              YYSTACK_FREE (yymsg);
+            yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
+            if (!yymsg)
+              {
+                yymsg = yymsgbuf;
+                yymsg_alloc = sizeof yymsgbuf;
+                yysyntax_error_status = 2;
+              }
+            else
+              {
+                yysyntax_error_status = YYSYNTAX_ERROR;
+                yymsgp = yymsg;
+              }
+          }
+        yyerror (yymsgp);
+        if (yysyntax_error_status == 2)
+          goto yyexhaustedlab;
+      }
+# undef YYSYNTAX_ERROR
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse lookahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse lookahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (!yypact_value_is_default (yyn))
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+  *++yyvsp = yylval;
+  YY_IGNORE_MAYBE_UNINITIALIZED_END
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#if !defined yyoverflow || YYERROR_VERBOSE
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEMPTY)
+    {
+      /* Make sure we have latest lookahead translation.  See comments at
+         user semantic actions for why this is necessary.  */
+      yytoken = YYTRANSLATE (yychar);
+      yydestruct ("Cleanup: discarding lookahead",
+                  yytoken, &yylval);
+    }
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+/* Line 2055 of yacc.c  */
+#line 2156 "fortran.y"
+
+
+void process_fortran(const char *input_file)
+{
+    extern FILE *fortran_in;
+    extern FILE *fortran_out;
+
+    char output_file[LONG_FNAME];
+    char input_fullpath[LONG_FNAME];
+
+    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
+
+     yydebug=0;
+/******************************************************************************/
+/*  1-  Open input file                                                       */
+/******************************************************************************/
+
+    strcpy(cur_filename, input_file);
+    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
+
+    fortran_in = fopen(input_fullpath, "r");
+    if (! fortran_in)
+    {
+        printf("Error : File %s does not exist\n", input_fullpath);
+        exit(1);
+    }
+
+/******************************************************************************/
+/*  2-  Variables initialization                                              */
+/******************************************************************************/
+
+    line_num_input = 1;
+    PublicDeclare = 0;
+    PrivateDeclare = 0;
+    ExternalDeclare = 0;
+    SaveDeclare = 0;
+    pointerdeclare = 0;
+    optionaldeclare = 0;
+    incalldeclare = 0;
+    inside_type_declare = 0;
+    Allocatabledeclare = 0 ;
+    Targetdeclare = 0 ;
+    VariableIsParameter =  0 ;
+    strcpy(NamePrecision,"");
+    c_star = 0 ;
+    functiondeclarationisdone = 0;
+    insubroutinedeclare = 0 ;
+    strcpy(subroutinename," ");
+    isrecursive = 0;
+    InitialValueGiven = 0 ;
+    GlobalDeclarationType = 0;
+    inmoduledeclare = 0;
+    incontainssubroutine = 0;
+    afterpercent = 0;
+    aftercontainsdeclare = 1;
+    strcpy(nameinttypename,"");
+
+/******************************************************************************/
+/*  3-  Parsing of the input file (1 time)                                    */
+/******************************************************************************/
+
+    sprintf(output_file, "%s/%s", output_dir, input_file);
+
+    if (firstpass == 0) fortran_out = fopen(output_file,"w");
+
+    fortran_parse();
+
+    if (firstpass == 0) NewModule_Creation_0();
+    if (firstpass == 0) fclose(fortran_out);
+}
+#line 2 "fortran.yy.c"
+
+#line 4 "fortran.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define yy_create_buffer fortran__create_buffer
+#define yy_delete_buffer fortran__delete_buffer
+#define yy_flex_debug fortran__flex_debug
+#define yy_init_buffer fortran__init_buffer
+#define yy_flush_buffer fortran__flush_buffer
+#define yy_load_buffer_state fortran__load_buffer_state
+#define yy_switch_to_buffer fortran__switch_to_buffer
+#define yyin fortran_in
+#define yyleng fortran_leng
+#define yylex fortran_lex
+#define yylineno fortran_lineno
+#define yyout fortran_out
+#define yyrestart fortran_restart
+#define yytext fortran_text
+#define yywrap fortran_wrap
+#define yyalloc fortran_alloc
+#define yyrealloc fortran_realloc
+#define yyfree fortran_free
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE fortran_restart(fortran_in  )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t fortran_leng;
+
+extern FILE *fortran_in, *fortran_out;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+    #define YY_LESS_LINENO(n)
+    
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortran_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		*yy_cp = (yy_hold_char); \
+		YY_RESTORE_YY_MORE_OFFSET \
+		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up fortran_text again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr)  )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	yy_size_t yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+    int yy_bs_lineno; /**< The line count. */
+    int yy_bs_column; /**< The column count. */
+    
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via fortran_restart()), so that the user can continue scanning by
+	 * just pointing fortran_in at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+
+	};
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+                          : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when fortran_text is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t fortran_leng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow fortran_wrap()'s to do buffer switches
+ * instead of setting up a fresh fortran_in.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void fortran_restart (FILE *input_file  );
+void fortran__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE fortran__create_buffer (FILE *file,int size  );
+void fortran__delete_buffer (YY_BUFFER_STATE b  );
+void fortran__flush_buffer (YY_BUFFER_STATE b  );
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void fortran_pop_buffer_state (void );
+
+static void fortran_ensure_buffer_stack (void );
+static void fortran__load_buffer_state (void );
+static void fortran__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER fortran__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE fortran__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE fortran__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE fortran__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *fortran_alloc (yy_size_t  );
+void *fortran_realloc (void *,yy_size_t  );
+void fortran_free (void *  );
+
+#define yy_new_buffer fortran__create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        fortran_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        fortran_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+#define fortran_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
+typedef unsigned char YY_CHAR;
+
+FILE *fortran_in = (FILE *) 0, *fortran_out = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int fortran_lineno;
+
+int fortran_lineno = 1;
+
+extern char *fortran_text;
+#define yytext_ptr fortran_text
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[]  );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up fortran_text.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	fortran_leng = (yy_size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 176
+#define YY_END_OF_BUFFER 177
+/* This struct is not used in this scanner,
+   but its presence is necessary. */
+struct yy_trans_info
+	{
+	flex_int32_t yy_verify;
+	flex_int32_t yy_nxt;
+	};
+static yyconst flex_int16_t yy_accept[1132] =
+    {   0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,  177,  176,  166,  164,  175,  176,  155,  158,
+      176,  176,  157,  157,  157,  160,  156,  144,  154,  157,
+      159,  162,  161,  163,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  166,  164,  166,  175,  154,  151,
+      151,  151,  151,  151,  151,  176,  176,  172,  176,  176,
+      176,  157,  151,    0,    0,  166,    0,    0,  175,  175,
+      175,    0,  148,    0,    0,    0,  168,    0,    0,    0,
+        0,    0,  147,    0,    0,  141,   25,    0,  153,    0,
+
+        0,    0,    0,    0,    0,    0,  142,    0,  154,    0,
+      140,   23,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,   42,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  100,  151,   89,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  166,  166,    0,  167,    0,
+        0,    0,    0,    0,    0,  165,  166,    0,  175,  174,
+      175,  175,  175,  167,  154,    0,  151,  151,  151,  151,
+
+       89,  151,  151,    0,  172,    0,    0,    0,    0,    0,
+        0,  173,   25,    0,    0,    0,  151,  151,  151,  151,
+      151,    0,    0,    0,  175,  175,    0,    0,    0,    0,
+        0,    0,    0,    0,  146,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,  152,  152,
+        0,  153,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  123,  151,  151,  151,
+      151,  151,  151,  151,   14,  151,  151,  151,  151,  122,
+      151,  151,  151,  151,  151,  151,  151,    0,  151,  151,
+      151,  151,  151,  151,  129,  151,  151,  134,  151,  151,
+
+      151,  151,  151,  151,  151,  151,   93,  151,  151,  151,
+      151,  151,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  126,  151,  151,  151,  151,  151,  130,  151,  151,
+      151,  151,  151,  151,  151,    0,  166,  166,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,  166,    0,  167,
+      175,  175,  175,  154,    0,  151,  151,  151,  151,  151,
+      151,  151,    0,    0,    0,    0,  173,    0,    0,    0,
+      151,  151,  151,  151,  151,    0,    0,    0,  175,  175,
+        0,    0,    0,    0,    0,    0,    0,    0,  153,    0,
+       27,    0,   29,   28,   31,   30,   33,    0,    0,   35,
+
+        0,    0,  133,  125,  151,  151,  128,  151,  131,  151,
+      151,   20,  151,  151,  151,  151,  151,  151,  124,  151,
+      151,  151,  151,  151,  151,   98,    0,  115,  151,  151,
+      151,  151,  151,  151,  151,  151,    0,  116,  151,    0,
+      117,  151,  151,  151,  151,  151,  151,    0,  113,  151,
+      151,    0,   92,  151,  151,  151,  151,  151,  151,  151,
+        0,  102,  151,  151,    0,  119,  151,  151,  151,  151,
+      120,    0,  114,   19,  151,   63,   77,  151,  151,  151,
+      151,  151,  151,  151,  151,   82,   43,  151,  151,  151,
+      151,   72,  151,  151,  127,  151,   76,   57,  151,    0,
+
+      101,  103,  151,   96,  105,  151,  151,  151,  151,   47,
+      166,  166,    0,    0,    0,    0,    0,    0,    0,  166,
+        0,  167,  175,  175,  175,  154,    0,  108,  151,  151,
+      151,  151,  151,   16,    0,    0,    0,    0,    0,    0,
+      151,  151,  151,  151,    0,    0,    0,  175,  175,    0,
+        0,    0,    0,    0,    0,   37,   26,    0,   34,   36,
+      151,  151,  151,  151,  151,  151,   52,  151,  151,  151,
+      151,  132,  151,  151,  151,  151,  151,    0,  151,  151,
+        0,    0,    0,    0,    0,    0,    0,    0,   41,  151,
+       99,  151,  151,  151,  151,  151,  151,  151,  151,   79,
+
+       79,  151,    0,  111,  121,   85,  151,  151,   92,  151,
+      151,   94,  151,  151,  151,  151,  151,  151,  151,  151,
+      151,  151,  151,    0,    0,  151,  151,  151,   55,  151,
+       80,  151,  151,  151,    0,  151,  151,  151,  151,  151,
+        0,  135,  106,  151,  151,    0,  112,   58,   39,   84,
+      166,  166,  108,    0,    0,    0,    0,    0,  166,    0,
+      167,  175,  175,  175,  154,    0,  108,  151,   90,  151,
+      151,   74,   73,   74,    0,    0,    0,    0,    0,  151,
+       52,  151,  132,    0,   21,    0,  175,   21,    0,   21,
+       21,    0,   21,    0,   21,   21,   21,   32,  151,  151,
+
+      151,   21,  151,  151,   66,  151,  151,  151,  151,  151,
+      151,  151,  145,    0,    0,   97,  151,   41,    0,   99,
+        0,    0,    0,    0,    0,    0,  151,  151,  151,  151,
+      151,  151,  151,  151,    0,  118,  151,  151,  151,  151,
+      151,  151,  151,   69,  151,  151,  137,  104,  136,  138,
+       38,  151,    0,    6,  151,  151,  151,  151,  151,  151,
+       87,    0,  151,    8,   78,   17,  151,  151,   86,  166,
+      166,    0,    0,    0,  166,  175,  175,   21,    0,  151,
+      151,  151,    0,    0,    0,   21,    0,  151,   21,   22,
+        0,  169,   22,   22,   22,   22,   22,   22,   22,   22,
+
+      151,  151,  151,  151,   50,  151,  151,  151,  109,  151,
+        0,  151,  151,   97,    0,  151,    0,    0,    0,    0,
+        0,    0,    0,  151,  151,  151,  151,  151,   75,  151,
+      151,  151,    0,    0,  151,  151,   15,   53,   44,  151,
+       45,    0,  151,  151,    5,  151,  151,   70,   88,    3,
+        0,    0,  151,    0,  151,  151,    0,    0,    0,  175,
+       22,    0,  151,   67,  151,    0,    0,   22,    0,   22,
+      151,    4,  151,  151,  151,  151,   91,  151,  151,    0,
+        0,  151,  151,    0,  151,    0,    0,    0,    0,    0,
+       75,    0,  151,  151,  151,  151,  151,   59,  151,   68,
+
+        0,    0,    0,    0,  143,    9,   18,  151,    0,  151,
+       83,   71,  151,    0,  151,    0,  151,  151,    0,    0,
+      175,    0,   62,  151,    0,    0,    0,  151,  151,  139,
+       46,  151,  151,   54,    0,    0,  151,  151,    0,   61,
+        0,    0,    0,    0,    0,   59,  151,   11,  151,  110,
+      151,  151,    0,    0,    0,    0,    0,  143,   95,    0,
+      151,   64,    0,   65,    0,  151,  151,   62,    0,  175,
+        0,  149,    0,    0,    0,  151,  151,   40,    7,    0,
+        0,  151,  151,   61,    0,   60,    0,   11,    0,  110,
+        0,  151,   10,  151,  151,    0,    0,    0,  151,    0,
+
+        0,  107,    2,  149,  175,    0,    0,    0,    0,   51,
+        0,    0,    0,    0,  151,  151,    0,   10,    0,   13,
+      151,   56,    0,    0,    0,  151,    0,  107,  175,    0,
+        0,    0,    0,    0,    0,    0,    0,  151,  151,   13,
+        0,  151,    0,    0,    0,  151,    0,  175,    0,    0,
+        0,    0,    0,   24,    0,    0,   49,  151,    0,   12,
+        0,    0,    0,  151,    0,  175,    0,    0,    0,  150,
+        0,   49,    0,  151,   12,    0,    0,    0,    0,  151,
+        0,  175,    0,    0,    0,    0,   48,    0,    0,    0,
+       81,    1,  175,    0,    0,    0,   48,   81,  175,    0,
+
+        0,    0,  175,    0,    0,    0,  175,    0,    0,    0,
+      175,    0,    0,    0,  175,    0,    0,    0,  175,  170,
+        0,  170,    0,    0,  170,    0,    0,    0,    0,  171,
+        0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    4,    5,    6,    7,    8,    9,   10,   11,   12,
+       13,   14,   15,   16,   17,   18,   19,   20,   21,   22,
+       23,   24,   25,   26,   27,   28,   29,   30,   31,   32,
+       33,   34,    1,    1,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   44,   45,   46,   47,   48,   49,   50,
+       51,   52,   53,   54,   55,   56,   57,   58,   59,   60,
+       61,    1,   62,    1,   63,    1,   64,   65,   66,   67,
+
+       68,   69,   70,   71,   72,   44,   73,   74,   75,   76,
+       77,   78,   79,   80,   81,   82,   83,   84,   85,   86,
+       87,   88,    1,   89,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[90] =
+    {   0,
+        1,    1,    2,    1,    1,    3,    1,    1,    1,    1,
+        1,    4,    1,    1,    1,    1,    1,    3,    1,    5,
+        5,    5,    5,    5,    5,    5,    5,    5,    5,    1,
+        1,    1,    1,    1,    6,    7,    7,    5,    5,    8,
+        9,   10,   11,   11,   11,    9,   11,    9,   12,   11,
+       13,    9,    9,    9,    9,   11,   11,   11,   11,   11,
+        1,    1,   11,    6,    7,    7,    5,    5,    8,    9,
+       10,   11,   11,    9,   11,    9,   12,   11,   13,    9,
+        9,    9,    9,   11,   11,   11,   11,   11,    3
+    } ;
+
+static yyconst flex_int16_t yy_base[1171] =
+    {   0,
+        0,   88,    0,    0,    0,    0,  984,   93,    0,   85,
+        0,    0,  891,   64,   98,  103,   80,  129,   96,   99,
+      134,  137,  145,  133,  168,  135,  249,  180,  318,  136,
+      156,  172,  212,  239,  246,  297,  366,  341,  414,  461,
+      247,  294,  398,  334,  407,  476,  506,  517,  459,  566,
+      572,  522,  571,  367,  653,  226,  656,  658,  737,  638,
+      785,  655,  698,  806,  652, 4012,  878, 4012,  241,  116,
+      124,  455,  893,   59,   76,  229,  253,  256,    0,  122,
+      127,  872, 4012,  157,  188,  869,  866,  327,  302,  349,
+      740,  416, 4012,  768,  592, 4012, 4012,  981,  730,  147,
+
+      184,  438,  495,  328,  184,  190, 4012, 1048,  335,  969,
+     4012, 4012,    0,  269,  315,  149,  319,  486,  462,  248,
+      318,  325,  269,  426,  736,  336,  767,  470,  500,  518,
+      512,  403,  516,  525,  535,  801,  544,  620,  565,  570,
+      589,  768,  483,  589,  810,  592,  613,  638,  650,  664,
+      678,  736,  737,  740,  741,  949,  736,  788,  646,  956,
+      756,  999,  739,  753,  804,  749, 1043,  972,  962,  769,
+      813,  963,  972,  969,    0, 1057,    0,  839,  238, 1044,
+      986,  789,  956, 1030,  965,  429, 1109, 1136,  830, 4012,
+     1061, 1087, 1091, 1162, 1188,  990, 1095, 1120, 1006, 1042,
+
+     1170, 1050, 1046,  823, 4012, 1201, 1099, 1115, 1190,  797,
+      483, 4012,  790, 1167, 1100, 1194, 1269, 1358, 1255, 1254,
+     1195, 1103, 1098,  625, 1148, 1163, 1217, 1237, 1222, 1238,
+     1095, 1305, 1325, 1234, 4012, 1334, 1302, 1326, 1107, 1182,
+      738,  735,  731,  730, 1244, 1166,  713, 1242, 4012, 1428,
+     1374, 1389, 1419, 1244, 1252, 1261, 1263, 1192, 1266, 1301,
+     1333, 1333, 1352, 1352, 1387, 1392, 1388, 1389, 1390, 1404,
+     1401, 1405, 1407, 1404, 1506, 1471, 1417, 1476, 1430,    0,
+     1422, 1437, 1442, 1432, 1484, 1440, 1454, 1497, 1444, 1448,
+     1451, 1443, 1445, 1475, 1459, 1530, 1536, 1464, 1477, 1470,
+
+     1531, 1490, 1491, 1482, 1509, 1511,    0, 1526, 1513, 1519,
+     1524, 1527, 1524, 1555, 1516, 1519, 1522, 1546, 1557, 1564,
+     1558, 1565, 1555, 1557, 1562, 1561, 1615, 1573, 1575, 1573,
+     1576, 1570, 1574, 1582, 1576,  719,  351,  666, 1572,  713,
+     1580, 1587, 1584, 1593, 1589, 1596, 1608, 1658, 1684, 1710,
+     1652, 1645, 1661, 1741, 1626, 1629, 1635, 1634, 1637, 1703,
+     1653,  709, 1654, 1744,  707,  998, 4012, 1712, 1674, 1715,
+     1664, 1708, 1725, 1738, 1749, 1622, 1684, 1379, 1672, 1735,
+     1743, 1771, 1723, 1772, 1787, 1804, 1815, 1807, 1821,  656,
+     4012,  646, 4012, 4012, 4012, 4012, 4012, 1735,  614, 4012,
+
+      613, 1849, 4012,    0, 1741, 1751,    0, 1796,    0, 1799,
+     1799,    0, 1820, 1819, 1811, 1816, 1808, 1821,    0, 1826,
+     1822, 1814, 1822, 1825, 1819, 1871, 1955, 4012, 1825, 1821,
+     1837, 1830, 1829, 1850, 1823, 1844, 1899, 4012, 1836, 1909,
+     4012, 1841, 2040, 1856, 1915, 1858, 1874, 1920, 4012, 1886,
+     1872, 1878,    0, 1886, 1879, 1881, 1888, 1896, 1895, 1902,
+     1967, 4012, 1897, 1906, 1971, 4012, 1900, 1912, 1906, 1915,
+        0, 1980, 4012,    0, 1988,    0,    0, 1929, 1939, 1926,
+     1933, 1936, 1946, 1939, 1953,    0,  602, 1949, 1958, 1955,
+     1963,    0, 1960, 2063,    0,  598,    0,    0, 1985, 2064,
+
+     4012,    0, 1960,    0,    0, 2019, 2022, 2024, 2025, 4012,
+      792,  880, 2030, 2023, 2043, 2043, 2041, 2042,  581, 2092,
+     2118, 2144, 2079, 2080, 2084, 2170, 2045, 1005, 2060, 1022,
+     2071, 2134, 2199,  574, 2082, 2174, 2108, 2147, 2148, 2101,
+     2154, 2184, 2187, 2190, 2087,    0, 1422, 2144,    0, 2200,
+      138, 2202,  571, 2221, 2233, 4012, 4012,  514, 4012, 4012,
+     2174, 2192, 2051, 2289, 2080, 2193,    0, 2109, 2194, 2193,
+     2199,    0, 2201, 2207, 2204, 2195, 2198, 2270, 2240, 2240,
+     2215, 2229, 2246, 2239, 2258, 2275, 2258, 2276,    0, 2276,
+        0, 2287, 2279, 2283, 2295, 2283, 2295, 2300, 2335, 4012,
+
+        0, 2293, 2342, 4012,    0,    0, 2294, 2293, 4012, 2316,
+     2321,    0, 2297, 2323, 2312, 2319, 2335, 2334, 2327, 2337,
+     2333, 2341, 2338,  197,  451, 2343, 2337, 2347,    0, 2348,
+        0, 2335, 2355, 2355,  477, 2343, 2343, 2350, 2355, 2348,
+     2275, 4012, 4012, 2349, 2351, 2404, 4012,    0,    0,    0,
+     1140, 1249, 1797, 2376, 2082, 2379, 2366, 2432, 2263,  424,
+      569, 2417, 2420,  499, 2486, 2384, 2087, 2385, 2427, 2389,
+     2398, 2437, 4012, 2448, 2444, 2439, 2452,  479, 2451, 2431,
+     2410, 2565, 2416,    0, 4012, 2653,    0,    0,  475,  445,
+     4012,  441,  436, 2458, 2462, 2468, 4012, 4012, 2682, 2404,
+
+     2428,    0, 2441, 2444,    0, 2442, 2449, 2447, 2480, 2465,
+     2479, 2553,    0, 2487, 2489,    0, 2493, 4012, 2486, 4012,
+     2497, 2509, 2513, 2527, 2535, 2549, 2552, 2538, 2550, 2555,
+     2548, 2562, 2552, 2559, 2604, 4012, 2572, 2480, 2561, 2568,
+     2573, 2575, 2564,    0, 2569, 2578,    0,    0,    0,    0,
+     2660, 2572,  508, 4012, 2583, 2594, 2591, 2650, 2664, 2658,
+        0, 2536, 2663,    0,    0,    0, 2715, 2654,    0, 2539,
+     2479, 2668, 2663, 2678, 2644, 2682,  426,  421, 2680, 2677,
+     2540, 2686, 2701, 2720,  411,  365, 2721, 2790, 2691, 4012,
+     2725, 4012,    0,  343, 4012,  307, 2753, 2755, 4012,    0,
+
+     2747, 2692, 2702, 2706,    0, 2707, 2709, 2719,    0, 2685,
+     2776, 2708, 2732, 4012, 2748, 2737, 2773, 2763, 2773, 2780,
+     2773, 2788, 2777, 2776, 2785, 2780, 2796, 2786,    0, 2797,
+     2798, 2794, 2647, 2867, 2796, 2791,    0,    0,    0, 2795,
+        0, 2845, 2798, 2801,    0, 2815, 2825,    0,    0,    0,
+     2872, 2840, 2825, 2883, 2847, 2843, 2840, 2548, 2855,  827,
+      303,  239, 2841, 2765, 2855, 1020, 2888,  288, 1687, 2861,
+     2861,    0, 2851, 2861, 2850, 2855,    0, 2851, 2858, 2858,
+     2856, 2863, 2873, 2862, 2878, 2870, 2882, 2880, 2881, 2888,
+     4012, 2904, 2901, 2906, 2913, 2885, 2895,    0, 2903,    0,
+
+     2951, 2978, 2955, 2982, 2994,    0,    0, 2933, 2910, 2917,
+        0,    0, 2923,  248, 2932, 2941, 2930, 2939, 2936, 2956,
+     2998, 2964,    0, 2967, 3005, 3006, 3007, 2966, 2959,    0,
+        0, 2960, 2979,    0, 2973, 2982, 2973, 2987, 2986, 3025,
+     2983, 2989, 2995, 2978, 2978, 4012, 2985,    0, 2991,    0,
+     2985, 3006, 3066, 3074, 3078, 3090, 3094, 3106,    0, 3009,
+     3019,    0, 3041,    0, 3018, 3050, 3056, 4012, 3062, 3076,
+     3056,    0, 3087, 3103, 3099, 3072, 3111,    0,    0, 3064,
+     3080, 3075, 3079, 3124, 3125, 4012, 3082, 4012, 3085, 4012,
+     3080, 3093,    0, 3096, 3104, 3152, 3171, 3113, 3118,  245,
+
+     3119,    0,    0, 4012, 1737,  184, 3142, 3141, 1922,    0,
+     3181, 3186, 3115, 3122, 3127, 3111, 3122, 4012, 3128,    0,
+     3129,    0, 3208, 3211, 3152, 3158, 3150, 4012, 3194, 3154,
+     2097, 3179, 3201, 3224, 3231, 3169, 3153, 3159, 3179, 4012,
+     3183, 3184, 3251, 3258, 3191, 3183,  207, 3229, 3207, 3237,
+      194, 3233, 3261, 4012, 3209, 3200,    0, 3220, 3211,    0,
+     3309, 3283, 3218, 3228, 3221, 3285, 3236, 3273,  142, 4012,
+     3286, 4012, 3243, 3250, 4012, 3339, 3342, 3367, 3248, 3286,
+      108, 2482,   40, 2606, 2838, 3273,    0, 3395, 3399, 3290,
+        0, 4012, 3302, 3294, 3311, 3350, 4012, 4012, 3299, 3320,
+
+     3357, 3358, 3375, 3318, 3359, 3380, 3404, 3376, 3300, 3412,
+     3362, 3363, 3370, 3415, 3418, 3423, 3420, 3426, 3433, 4012,
+     3447, 4012, 3428, 3451, 4012, 3430, 3439, 3454, 3457, 4012,
+     4012, 3521, 3534, 3547, 3560, 3573, 3586, 3595, 3608, 3621,
+     3634, 3647, 3656, 3669, 3678, 3686, 3699, 3712, 3725, 3738,
+     3751, 3764, 3777, 3790, 3803, 3816, 3829, 3842, 3855, 3868,
+     3881, 3894, 3907, 3920, 3933, 3946, 3959, 3972, 3985, 3998
+    } ;
+
+static yyconst flex_int16_t yy_def[1171] =
+    {   0,
+     1131,    1, 1132, 1132,    1,    2, 1133, 1133,    1,    2,
+        1,    2, 1131, 1131, 1131, 1131, 1134, 1135, 1131, 1131,
+     1136, 1137, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138,   40, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131,   55, 1139, 1131,   37,
+     1138, 1138, 1138, 1138, 1138, 1131, 1140, 1131, 1140, 1140,
+     1140, 1141, 1131, 1131, 1131, 1131, 1131, 1131, 1134, 1134,
+     1134, 1135, 1131, 1135, 1135, 1136, 1131, 1136, 1136, 1137,
+     1142, 1137, 1131, 1137, 1137, 1131, 1131, 1131, 1143, 1131,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,   29, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1145,   55,  176, 1146, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131,  176, 1131, 1139, 1131,
+     1139, 1139, 1139, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1140, 1131, 1140, 1140, 1140, 1140, 1147,
+     1147, 1131, 1147, 1147, 1147, 1147, 1148, 1148,  218,  218,
+      218, 1131, 1131, 1131, 1134, 1134, 1135, 1135, 1136, 1136,
+     1142, 1142, 1142, 1142, 1131, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1144,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1145,  176,  176, 1131, 1146,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131,  187, 1131, 1131,
+     1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1140, 1140, 1147, 1147, 1131, 1147, 1147, 1147,
+      218,  218,  218,  218,  218, 1131, 1131, 1131, 1134, 1134,
+     1135, 1135, 1136, 1136, 1142, 1137, 1137, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1131, 1131, 1138, 1131,
+     1131, 1138, 1149, 1138, 1138, 1138, 1138, 1131, 1131, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131, 1131,  187,
+     1131, 1131, 1139, 1139, 1139, 1131, 1131, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1140, 1140, 1140, 1147, 1147, 1147,
+      218,  218,  218,  218, 1131, 1150, 1131, 1134, 1151, 1135,
+     1152, 1136, 1153, 1137, 1154, 1131, 1131, 1131, 1131, 1131,
+     1138, 1138, 1138, 1155, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131, 1138, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1131, 1138, 1138, 1131, 1131, 1138, 1138, 1138,
+      176,  176, 1131, 1131, 1131, 1131, 1131, 1131,  176, 1131,
+     1131, 1139, 1139, 1156, 1131, 1131, 1131, 1138, 1131, 1138,
+     1138, 1131, 1131, 1131, 1140, 1140, 1147, 1157, 1147,  218,
+      218, 1158,  218, 1159, 1131, 1131, 1160, 1134, 1161, 1135,
+     1131, 1162, 1136, 1163, 1137, 1137, 1131, 1131, 1164, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,  176,
+      176, 1131, 1131, 1131,  176, 1139, 1165, 1139, 1131, 1138,
+     1138, 1138, 1140, 1140, 1166, 1147, 1147, 1167,  218, 1131,
+     1131, 1131, 1134, 1135, 1131, 1136, 1137, 1137, 1131, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1138, 1138, 1131, 1131, 1138, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1168, 1138, 1138, 1138, 1138, 1138, 1138,
+     1138, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+     1131, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1131, 1139,
+     1139, 1131, 1138, 1131, 1138, 1140, 1140, 1147, 1147,  218,
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1138, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138,
+
+     1168, 1168, 1131, 1169, 1168, 1138, 1138, 1138, 1131, 1138,
+     1138, 1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131,
+     1139, 1131, 1138, 1138, 1140, 1140, 1147, 1138, 1138, 1138,
+     1138, 1138, 1138, 1138, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1131, 1131, 1131, 1131, 1131, 1138, 1138, 1138, 1138,
+     1138, 1138, 1131, 1169, 1169, 1168, 1169, 1169, 1138, 1131,
+     1138, 1138, 1131, 1138, 1131, 1138, 1138, 1131, 1131, 1139,
+     1131, 1138, 1140, 1140, 1147, 1138, 1138, 1138, 1138, 1131,
+     1131, 1138, 1138, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1138, 1138, 1138, 1138, 1131, 1168, 1131, 1138, 1131,
+
+     1131, 1138, 1138, 1131, 1139, 1131, 1140, 1140, 1147, 1138,
+     1131, 1131, 1131, 1131, 1138, 1138, 1131, 1131, 1131, 1138,
+     1138, 1138, 1131, 1168, 1131, 1138, 1131, 1131, 1139, 1131,
+     1140, 1140, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131,
+     1131, 1138, 1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140,
+     1170, 1147, 1131, 1131, 1131, 1131, 1138, 1138, 1131, 1138,
+     1131, 1168, 1131, 1138, 1131, 1139, 1131, 1140, 1170, 1131,
+     1147, 1131, 1131, 1138, 1131, 1131, 1168, 1168, 1131, 1138,
+     1131, 1139, 1131, 1140, 1147, 1131, 1138, 1168, 1169, 1131,
+     1138, 1131, 1139, 1131, 1140, 1147, 1131, 1131, 1139, 1131,
+
+     1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147,
+     1139, 1131, 1140, 1147, 1139, 1131, 1140, 1147, 1139, 1131,
+     1131, 1131, 1140, 1147, 1131, 1140, 1140, 1140, 1140, 1131,
+        0, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131
+    } ;
+
+static yyconst flex_int16_t yy_nxt[4102] =
+    {   0,
+       14,   15,   16,   15,   17,   18,   14,   19,   20,   21,
+       22,   23,   24,   25,   24,   26,   24,   27,   28,   29,
+       29,   29,   29,   29,   29,   29,   29,   29,   29,   30,
+       31,   32,   33,   34,   35,   36,   37,   38,   39,   40,
+       41,   42,   43,   42,   42,   44,   45,   46,   47,   48,
+       42,   49,   50,   51,   52,   42,   53,   42,   42,   54,
+       24,   24,   42,   35,   36,   37,   38,   39,   40,   41,
+       42,   43,   42,   44,   45,   46,   47,   48,   42,   49,
+       50,   51,   52,   42,   53,   42,   42,   54,   14,   55,
+       56,   57,   58,  222,   69,   68,   69,   70,   72,   76,
+
+       77,   76, 1094,   74,   78,   77,   78,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   59,   75,  205,   80,
+     1092,   73,  222,  208,   60,   61,  205,  223,   62,   70,
+       63,   71,   74,   81,   83,   74,   87,   74,   74,   91,
+       82,   64,   65,  691, 1070,   75,   92,   93,   80,   75,
+       73,   75,   75,   60,   61,  223,  225,   62,   70,   63,
+       71,   81,   83,   96,   74,  111,   74,   74,   84,   64,
+       65,  209,   74,   88,   74,   74,   94,   75,  226,   75,
+       75,   97,   85,  255,   74,  225,   75,   89,   75,   75,
+       95,  227,  107,   83,  239,   74, 1070,   84,   75,  209,
+
+      624,   74,   88,   74,   74,   94,  226,   74,  625,   75,
+       85,   74,  255,   74,   75,   89,   75,   75,   95,   74,
+      227,   75,  239, 1065,   74,   75,   75,   78,   77,   78,
+       76,   77,   76,   75,  240,  247,   74,   75,  248,  228,
+       74,  179,  206,  205,  206,  112, 1030,  179,   74,   75,
+       98,   74,   98,   75,   78,   77,   78,  224,   77,  224,
+     1027,   75,  240,  247,  963,   75,  248,  228,   99,   99,
+       99,   99,   99,   99,   99,   99,   99,   99,   74,  207,
+       74,  114,  115,  100,  261,  116,  116,  101,   74,  102,
+      212,  117,   75,   75,  103,  142,  104,  105,  118,  119,
+
+      121,  922,   75,  263,   87,  190,  106,   74,  207,   87,
+      114,  115,  100,  261,  116,  116,  101,   74,  102,  117,
+       75,  253,  103,  142,  104,  105,  118,  119,  121,   87,
+       75,  120,  263,  116,  106,  108,  116,  109,  109,  109,
+      109,  109,  109,  109,  109,  109,  109,  121,   83,  253,
+      121,   91,  511,  230,  512,  110,  110,   74,   92,   93,
+      120,  229,  116,  254,  256,  116,  245,  212,  110,  260,
+      262,   75,  268,  116, 1131,  121,  246,  175,  121,  127,
+      116,  230,  146,  128,  110,  110,   74,  121, 1131,  129,
+      229,  254,  256,  130,  121,  245,  110,  260,  262,   75,
+
+      122,  268,  116, 1131,  246,  116,  116,  123,  127,  116,
+      146,  124,  128,  212,  125,  121, 1131,  129,   91,  121,
+      121,  130,  121,  190,  126,   92,   93,  179,  190,  122,
+       78,   77,   78,  179,  116,  116,  123,  143,   87,  124,
+      275,  147,  125,   87,  144,  145,  116,  121,  121,  148,
+       83,  121,  126,  116,  753,  149,  211,  212,  211,  131,
+      121,  132,  133,  754,  134,  135,  143,  121,  213,  275,
+      147,  136,  144,  145,  264,  116,  241,   82,  148,  121,
+      795,  212,  116,  149,  366,  367,  366,  131,  121,  132,
+      133,  242,  134,  135,  214,  121,  259,  162,  116,  136,
+
+      116,  190,  264,  137,  762,  241,  138,  139,  215,  140,
+      150,  753,  121,  260,  121,  141,  271,  255,  151,  242,
+      754,  113,  152,  214,  153,  259,  162,  116,  257,  116,
+      154,  698,  137,  243,  138,  139,  215,  140,  258,  150,
+      121,  260,  121,  141,  271,  116,  255,  151,  244,  113,
+      152,  158,  153,  155,  272,  156,  116,  257,  154,  121,
+      157,  116,  243,  273,  274,  159,  258,  276,  160,  172,
+      121,  161,  179,   87,  116,  121,  244,  534,  179,  277,
+      158,  155,  272,  156,  534,  116,  278,  121,  157,  282,
+      116,  273,  274,  159,   91,  276,  160,  172,  121,  161,
+
+      163,   92,   93,  121,  164,  116,  169,  277,  165,  643,
+      116,  116,  173,  170,  278,  635,  166,  282,  285,  167,
+      168,  286,  174,  171,  121,  121,  378,   77,  378,  163,
+      560,  559,  295,  164,  116,  169,  287,  165,  290,  116,
+      116,  173,  170,  237,  166,  196,  285,  167,  168,  286,
+      174,  171,  121,  121,  176,   77,  177,  178,  186,  187,
+      190,  295,  179,  557,  287,  191,  290,  511,  283,  512,
+      296,  237,  197,  556,  284,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  297,  198,  298,  310,  180,
+      181,  116,   74,  182,  116,  183,  283,  192,  296,  172,
+
+      200,  197,  284,  142,  203,  121,  184,  185,  121,  212,
+      299,  193,  534,  297,  198,  190,  298,  310,  180,  181,
+      116,   74,  182,  116,  183,  300,  192,  172,  200,  510,
+      400,  142,  203,  121,  184,  185,  121,  143,  299,  193,
+      194,  232,  233,  232,  144,  201,  179,  396,  395,  234,
+      235,  121,  394,  300,  108,  393,  195,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  143,  238,  238,  288,
+       91,  288,  144,  201,  110,  110,   74,   92,   93,  121,
+      238,  301,  265,  266,  302,  303,  304,  110,  267,  307,
+       75,  313,  212,  651,  319,  652,  238,  238,  320,  212,
+
+      323,  269,  236,  110,  110,   74,  270,  330,  238,  301,
+      265,  266,  302,  303,  304,  110,  267,  307,   75,  199,
+      313,  289,  319,  127,  116,  205,  320,  128,  323,  190,
+      269,  236,  190,  129,  344,  270,  330,  130,  121,  308,
+      169,  190,  309,  279,  321,  116,  291,  170,  199,  289,
+      280,  322,  127,  116,  281,  331,  128,  171,  292,  121,
+      293,  129,  344,  294,  202,  130,  121,  308,   87,  169,
+      309,   87,  279,  321,  116,  291,  170,   83,  280,  322,
+      205,  651,  281,  652,  331,  171,  292,  121,  293,  921,
+     1131,  294,  202,  210,  211,  212,  211,  210,  210,  210,
+
+      216,  210,  210,  210,  210,  210,  210,  210,  210,  210,
+      210,  210,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  210,  210,  210,  210,  210,  197,  217,  217,
+      217,  217,  218,  217,  123,  217,  217,  217,  219,  217,
+      217,  198,  217,  217,  217,  217,  220,  217,  217,  217,
+      217,  221,  217,  210,  210,  217,  197,  217,  217,  217,
+      217,  218,  217,  123,  217,  217,  219,  217,  217,  198,
+      217,  217,  217,  217,  220,  217,  217,  217,  217,  221,
+      217,  210,   98,  251,   98,  251,   68,  305,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  311,  366,
+
+      367,  366,  306,  345,  312,  332,  667,  326,  667,  328,
+      333,  335, 1131,  329,  334,  100,  305,  347,  327,  101,
+      343,  102,  205,  669,  355,  669,  103,  311,  104,  105,
+      306,  345,  312,  314,  332,  315,  326,  328,  106,  333,
+      335,  329, 1131,  334,  100,  347,  327, 1131,  101,  343,
+      102,  316,  317,  355,  103,  318,  104,  105,  337,  358,
+      338, 1131,  314,  190,  315, 1131,  106,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  324,  341,  316,
+      317,  223,  925,  318,  362,  110,  110,  358,  346,  190,
+      359,  325,  342,  190,  260,  351, 1131,  233,  110,  361,
+
+     1131,  205,  212, 1131,  385,  235,  324,  341, 1131,  223,
+      339,  186,  348,  362,  110,  110,  346,  205,  359,  325,
+      342,  352,  260, 1131,  351, 1131,  110,  361,  349,  349,
+      349,  349,  349,  349,  349,  349,  349,  349,  339,  350,
+      262,  770,  353,  771,  390,  179,  209,  356,  376,  363,
+      352,  369,  377, 1131, 1131,  349,  349,  349,  349,  349,
+      349,  349,  349,  349,  349,  350,  265,  357,  262,  212,
+      353,  179,  267,  390,  209,  356,  376, 1131,  363,  369,
+      377,  349,  349,  349,  349,  349,  349,  349,  349,  349,
+      349,  350,  205,  379,  265,  357,  212,  179, 1131,  391,
+
+      267,  368,  206,  205,  206,  108,  291,  354,  354,  354,
+      354,  354,  354,  354,  354,  354,  354,  380,  292,  399,
+      293,  379,   83,  360,   87,  110,  110,  364,  370,  371,
+      368,  375, 1131, 1131,  408,  291,  233,  392,  110,  207,
+       87, 1131,   83,  385,  235,  380,  292,  399,  293, 1131,
+      770,  360,  771, 1131,  110,  110,  364,  370,  371, 1131,
+      375,  397,  381,  408, 1131,  392,  110,  383,  207,  365,
+      365,  212,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  365,  371,  371,
+      381,  382,  384,  401,  398,  383,  404,  405,  365,  365,
+
+      365,  365,  365,  373,   91,  374,  232,  233,  232,  406,
+      407,   92,   93,  409,  234,  235, 1131,  371,  371,  382,
+      384,  401,  398, 1131,  404,  405,  232,  233,  232,  365,
+      365,  373, 1131,  374,  234,  235,   91,  406,  407, 1131,
+      388,  409,  388,   92,   93,  389,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  410,  387,  365,  365,  365,
+      212,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  365,  365,  365,  365,  365,  411,  412,  386,
+      547,   77,  547,  410,  387, 1131, 1131,  365,  365,  365,
+      365,  365,  372,  252,  252,  252,  252,  252,  252,  252,
+
+      252,  252,  252,  413,  414,  411,  412,  386,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  365,  365,
+      402,  372,  402,  686,   77,  686, 1131, 1131,  417,  419,
+      403,  413,  414,  415,  420,  421,  416, 1131,  422,  423,
+      424,  425,  426, 1131, 1131,  418,  365,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  417,  419,  439,
+      444,  415,  420,  421,  416,  238,  238,  422,  423,  424,
+      425,  426,  437,  418,  437,  445,  446,  440,  238,  440,
+     1131, 1131,  442,  443,  447,  448,  450,  448,  439,  444,
+      451, 1131,  453,  454,  238,  238,  455,  456,  288,  457,
+
+      288,  460, 1131,  438,  445,  446,  238,  427,  441,  427,
+      442,  443,  447,  458,  450,  470,  449, 1131,  469,  451,
+      453,  454, 1131,  471,  455,  456,  459,  457,  474, 1131,
+      460,  461,  472,  461,  472, 1131,  475,  465,  428,  465,
+      476,  462,  458,  429,  470,  430,  469,  466,  431, 1131,
+      452,  471,  432,  478,  459,  433,  477,  474,  434,  435,
+      479, 1131,  436,  473,  475,  480,  481,  484,  476,  485,
+      488,  482,  429,  489,  430,  463,  490,  431,  452,  483,
+      432,  467,  478,  433,  477,  464,  434,  435,  491,  479,
+      436,  468,  486,  480,  481,  492,  484,  485,  488,  482,
+
+      487,  489,  493,  463,  490,  494,  495,  483,  496,  467,
+      497,  498,  499,  464,  502,  503,  500,  491,  500,  468,
+      504,  486,  505,  506,  492,  507,  501,  508,  487,  509,
+      346,  493,  513,  494,  514,  495,  496,  515,  497,  498,
+      499,  516,  517,  502,  503,  518,  519,  190,  504, 1131,
+      505,  506, 1131,  507,  190,  508,  205,  509,  346,  511,
+      513,  520,  514,  190, 1131,  515,  527,  528,  530,  516,
+      517,  417,  531,  518,  545,  519,  212,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,  529,  212,
+      524,  533,  523,  179,  535,  527,  528,  530,  371, 1131,
+
+      417,  531,  545,  521,  521,  521,  521,  521,  521,  521,
+      521,  521,  521,  522,  212,  525,  529,  212,  524,  179,
+      533,  523,  546,  535,  548,   87, 1131,  371,  539,  521,
+      521,  521,  521,  521,  521,  521,  521,  521,  521,  190,
+     1131,  532,  371,  525,  522,  536,  205,  536,   83,  927,
+      179,  546,  548,  541,  459,  540,  539,  538,  108,  371,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  526,
+      532,  371,  371,  549,   87,  552,   83,  542,  110,  110,
+     1131,  541,  459,  371,  540,  538,  537,  562,  371,  233,
+      558,  110,  543,  561,  544,  550,  385,  235,  667, 1029,
+
+      667,  371,  549,  552, 1131,  542,   91,  110,  110,  551,
+      553, 1131,  371,   92,   93,  537,  562,   91,  558,  110,
+      543,  561,  544,  550,   92,   93,  389,  389,  389,  389,
+      389,  389,  389,  389,  389,  389,  563,  564,  551,  553,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  565,  402,  555,  566, 1131,  554,  567, 1131,  568,
+      403,  569,  570,  571,  572,  563,  564,  573,  574,  575,
+      576,  577,  578,  589,  578,  590,  591, 1131,  592,  565,
+      593,  596,  555,  566,  554,  597,  567,  568,  594,  569,
+      570,  598,  571,  572,  599,  573,  574,  575,  576,  577,
+
+      437,  589,  437,  590,  595,  591,  592,  602,  593,  596,
+      440,  605,  440,  579,  597,  606,  603,  594,  603,  598,
+      607,  448,  599,  448,  212,  608,  609,  580,  610, 1131,
+      613,  438,  595,  611,  612,  602,  614,  616,  617,  605,
+      619,  441,  579,  615,  606,  618,  621,  604,  620,  607,
+     1131,  622,  449,  608,  609,  580,  427,  610,  427,  613,
+      623,  611,  612, 1131,  629,  614,  616,  617,  461,  619,
+      461,  615,  465,  618,  465,  621,  620,  627,  462,  622,
+      632,  472,  466,  472, 1033,  628,  630,  428,  623,  631,
+      633,  624,  581,  629,  582,  634,  640,  583,  645,  625,
+
+      636,  584, 1131,  637,  585,  627,  638,  586,  587,  632,
+      639,  588,  473,  628,  630, 1131, 1131,  631,  633, 1131,
+      646,  581,  646,  582,  634,  640,  583,  645,  636,  584,
+      626,  637,  585,  644,  638,  586,  587, 1131,  639,  588,
+      600,  600,  600,  600,  600,  600,  600,  600,  600,  600,
+      600,  647,  600,  600,  600,  600,  600,  600,  600,  626,
+      648,  644,  649,  650,  641,  500,  641,  500,  653,  600,
+      600,  600,  600,  600,  642,  501,  654,  655,  656,  657,
+      658,  190,  190,  669,  205,  669,  190, 1131,  667,  648,
+      667,  649,  650,  651,  668,  659,  666,  653,  701,  205,
+
+      600,  600,  571,  212,  654,  670,  655,  656,  657,  658,
+      205,  660,  660,  660,  660,  660,  660,  660,  660,  660,
+      660,  661,  664,  668,  666,  684,  701,  179,  600,  703,
+      662,  571,  663,  675,  670, 1131, 1131,  660,  660,  660,
+      660,  660,  660,  660,  660,  660,  660,  661, 1131,  212,
+      212,  664,  679,  179,  684,  676,  705,  703,  662, 1050,
+      663,  675, 1131,  660,  660,  660,  660,  660,  660,  660,
+      660,  660,  660,  661,  614,  536,  205,  536, 1131,  179,
+      679,  615,  687,  676,  705,  671,  678,  108,  371,  665,
+      665,  665,  665,  665,  665,  665,  665,  665,  665,  677,
+
+      672, 1131,  672,  614,   87,   83,  680,  110,  110,  615,
+      673,  687,  699,  671,  674,  678,  537,  371,  371, 1131,
+      110,  371,  681,   91,  371,  682,  700,  677,  683,  704,
+       92,   93,  706,  712,  680,   91,  110,  110,  689,  713,
+      692,  699,  696,  697,  707,  537,  708,  371,  110,  709,
+      371,  681,  710,  371,  682,  700,  711,  683,  704,  694,
+     1131,  706,  712,  718,  770,  186,  775,  689,  713,  692,
+     1131,  578,  707,  578,  708, 1131,  641,  709,  641,  716,
+      710,  717, 1131,  719,  711,  720,  642,  721,  694,  685,
+      685,  718,  685,  685,  685,  685,  685,  685,  685,  685,
+
+      685,  685,  685,  685,  685,  685,  685,  685,  716,  722,
+      717,  719,  714,  723,  720,  721,  725,  726,  685,  685,
+      685,  685,  685,  727,  728, 1131,  715,  729,  730,  724,
+      731, 1131,  732,  733,  734,  739,  735,  722,  735, 1131,
+      737,  714,  723,  603,  725,  603,  726,  738,  742,  685,
+      685,  727,  740,  728,  715,  729,  730,  724,  741,  731,
+      732,  743,  733,  734,  739,  744,  745,  736,  737,  746,
+      747, 1131,  748,  749,  604,  738,  742,  685,  750,  751,
+      752,  740,  755, 1131,  756,  757,  758,  741,  759,  760,
+      743,  761,  766,  744,  745,  763,  764,  765,  746,  747,
+
+      748,  767,  749,  768,  769,  646,  750,  646,  751,  752,
+      772,  755,  756,  773,  757,  758,  759,  774,  760,  190,
+      761,  766,  190,  763,  764,  765,  779,  780,  669,  767,
+      669,  768,  769,  672,  781,  672,  647,  782,  672,  772,
+      672,  205,  773,  673,  371,  774,  205,  674,  673,  674,
+      371,  674,  674,  212,  212,  779,  780,  801,  777,  776,
+       91, 1131,  781,  674,   91,  371,  782,  798,  799,  788,
+       91,   92,   93,  371,  802,  803, 1131,   92,   93,  371,
+      770,  833,  771,  833,  190,  801,  783,  777,  776,  179,
+      785,  834,  784,  787,  371,  179, 1131,  804,  788,  805,
+
+      806,  807,  802,  108,  803,  109,  109,  109,  109,  109,
+      109,  109,  109,  109,  109,  783,  808, 1131,  809,  785,
+      784,  810,  787,  110,  110,  804,  814,  805,  806,  807,
+      815,  816, 1131,  817,  818, 1131,  110,  851, 1131,  851,
+      770,  864,  770,  864, 1093,  808,  809,  852, 1131,  864,
+      810,  864,  110,  110,  811,  814,  811,  819,  820,  815,
+      816,  817,  821,  818,  110,  786,  786,  212,  786,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  786,  786,  822,  819,  820,  823,  824,  812,
+      826,  821,  825,  827,  786,  786,  786,  786,  786,  828,
+
+      829, 1131,  813,  830,  831,  735,  832,  735,  205,  835,
+      836,  837,  822,  838, 1131,  839,  823,  824,  812,  826,
+      825,  840,  827,  841,  844,  786,  786,  828,  846,  829,
+      813,  830,  831, 1131, 1131,  832,  736,  835, 1131,  836,
+      837,  845,  838,  839,  847,  770,  186,  775,  833,  840,
+      833,  841,  844,  786,  791,   77,  791,  846,  834,  792,
+      792,  842,  792,  842, 1131, 1131,  792,  792, 1095,  845,
+      792, 1131,  847,  792,  792,  792,  792,  792,  792,  792,
+      792,  792,  790,  790,  190,  790,  790,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  790,  790,
+
+      790,  848,  849,  205,  850,  853, 1131,  856,  858,  843,
+      857,  790,  790,  790,  790,  790,  854,  859,  854,  862,
+      865,  860,  205,  212,  863,  371,  791,   77,  791,  848,
+      873,  849,  850,  879,  853,  856,  858,  843,  874,  857,
+      866, 1131,  790,  790,  875,  876,  859,  877,  862,  865,
+      860,  855,  863,  878,  371,   91,  882,   91,  867,  873,
+      869,  879,   92,   93,   92,   93,  864,  874,  864,  866,
+      790, 1131, 1131,  875,  876, 1131,  877,  811, 1131,  811,
+      855,  871,  878,  883,  882,  872,  884,  867,  885,  869,
+      868,  868,  212,  868,  868,  868,  868,  868,  868,  868,
+
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  886,
+      871,  883,  880,  888,  872,  884,  885,  887,  889,  868,
+      868,  868,  868,  868,  890,  881,  891, 1131,  892,  893,
+      894,  895,  896, 1131,  897,  898,  899,  908,  886,  900,
+      212,  880,  888,  906,  907,  887,  842,  889,  842,  910,
+      868,  868,  890,  881,  911,  891,  892,  893,  894,  895,
+      912,  896,  897,  913,  898,  899,  908,  900,  902,  903,
+      902,  906,  907,  851,  914,  851,  904,  910,  868,  905,
+      915,  917,  911,  852,  854,  918,  854,  919,  912,  920,
+      205,  924,  913,  923,  909,  371,  928, 1131,  929,  930,
+
+     1096,  931,  932,  914,  933,  934,  935,  936,  915,  937,
+      917,  938, 1131,  939,  918,  919,  940,  944,  920,  916,
+      924,  923,  909,  941,  371,  928,  929,  942,  930,  931,
+      932,  943,  933,  934,  935,  936,  945,  937,  950,  926,
+      938,  939,  946,  947,  948,  940,  944,  949,  916,  951,
+      952,  941,  902,  903,  902,  942,  953,  903,  953,  943,
+      904,  960, 1131,  905,  945,  961,  950,  926, 1131,  959,
+      964,  946,  947,  948,  962,  965,  949,  951,  952,  902,
+      903,  902,  966,  955,  956,  955,  967,  904,  968,  960,
+      905,  957,  969,  961,  958,  902,  903,  902,  959,  964,
+
+      190,  971,  962,  904,  965,  972,  905,  205,  205,  212,
+      966,  976,  977,  978,  967, 1131,  968,  979, 1131,  980,
+      981,  969,  982,  983,  984,  987,  985,  988,  985,  989,
+      971,  990,  991,  992,  972,  970,  986,  993,  994,  976,
+      977,  978,  995,  973,  975,  974,  979,  980, 1131,  981,
+      982, 1131,  983,  984,  987,  999,  988,  998,  989,  990,
+      991,  992, 1131, 1131,  970,  993,  994,  996,  903,  996,
+     1001,  995,  973,  975,  974,  955,  956,  955,  190,  955,
+      956,  955, 1000,  957,  999,  998,  958,  957, 1002,  205,
+      958,  997,  956,  997, 1003,  955,  956,  955, 1001,  904,
+
+     1004,  212,  905,  957, 1006,  205,  958,  955,  956,  955,
+     1010, 1000, 1011, 1013, 1011,  957, 1014, 1002,  958, 1131,
+     1015, 1016, 1012, 1003, 1005,  985,  985,  985,  985, 1004,
+     1017, 1018, 1006, 1019, 1007,  986,  986, 1008, 1021, 1010,
+     1020, 1013, 1022,  205,  205, 1014, 1131, 1009, 1015, 1025,
+     1016, 1131, 1005, 1023,  903, 1023, 1026, 1028, 1017, 1018,
+     1036, 1019, 1007, 1039, 1037, 1038, 1008, 1021, 1020, 1040,
+     1041, 1022, 1024,  903, 1024, 1009, 1042, 1032, 1025, 1031,
+      904,  205, 1011,  905, 1011, 1026, 1028, 1034, 1036, 1034,
+     1045, 1039, 1012, 1037, 1038, 1046,  190, 1040, 1047, 1041,
+
+     1035, 1049, 1035,  212, 1042, 1056, 1032, 1055, 1031, 1043,
+      903, 1043, 1044,  903, 1044, 1131, 1057, 1051, 1035, 1045,
+      904, 1058, 1060,  905, 1046, 1034, 1047, 1034, 1063, 1049,
+     1059,  190, 1053, 1056, 1053,  212, 1055, 1064, 1035,  205,
+     1035, 1048, 1073, 1054, 1057, 1035, 1051, 1035, 1052, 1075,
+     1058, 1060, 1061,  903, 1061, 1067, 1035, 1063, 1059, 1062,
+      903, 1062, 1053, 1035, 1053, 1064, 1072,  904, 1074, 1048,
+      905, 1073, 1079, 1054, 1068,  205, 1052, 1066, 1075, 1080,
+     1081, 1071, 1131, 1067, 1078,  903, 1078,  190,  212, 1083,
+     1131, 1086,  904, 1131, 1072,  905, 1074, 1087, 1131, 1090,
+
+     1079,  190,  205, 1068,  190, 1066, 1131, 1080, 1081, 1071,
+     1076,  903, 1076,  205, 1131, 1077, 1077, 1083, 1077, 1086,
+     1097, 1084, 1077, 1077, 1091, 1087, 1077, 1090, 1098, 1077,
+     1077, 1077, 1077, 1077, 1077, 1077, 1077, 1077, 1082, 1085,
+     1076,  903, 1076,  902,  903,  902, 1131, 1100, 1097, 1084,
+     1103,  904,  212, 1091,  905, 1099, 1108, 1098, 1101,  205,
+      212,  205, 1113, 1131,  190, 1131, 1082, 1085,  902,  903,
+      902, 1104,  205, 1088, 1088, 1100, 1089,  190, 1103,  905,
+     1088, 1088,  212, 1099, 1088, 1108, 1101, 1088, 1088, 1088,
+     1088, 1088, 1088, 1088, 1088, 1088,  902,  903,  902, 1104,
+
+      955,  956,  955, 1102,  904, 1105,  190,  905,  957, 1106,
+     1112,  958, 1109, 1107,  212, 1115, 1116,  212, 1110, 1119,
+     1120, 1119,  205, 1117, 1121, 1122, 1121, 1124, 1125, 1124,
+      205, 1102,  205, 1105, 1119, 1120, 1119, 1106, 1111, 1112,
+     1109,  205, 1107, 1115, 1116, 1131, 1114, 1110, 1121, 1122,
+     1121, 1117, 1124, 1125, 1124, 1129, 1130, 1129, 1129, 1130,
+     1129, 1131, 1131, 1131, 1127, 1131, 1126, 1111, 1118, 1131,
+     1131, 1123, 1131, 1131, 1131, 1114, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1128, 1127, 1131, 1126, 1118, 1131, 1131, 1123,
+
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1128,   66,   66,   66,   66,   66,   66,   66,   66,   66,
+       66,   66,   66,   66,   67,   67,   67,   67,   67,   67,
+       67,   67,   67,   67,   67,   67,   67,   79, 1131,   79,
+       79,   79,   79,   79,   79,   79,   79,   79,   79,   79,
+       82,   82,   82,   82,   82,   82,   82,   82,   82,   82,
+       82,   82,   82,   86,   86,   86,   86,   86,   86,   86,
+       86,   86,   86,   86,   86,   86,   90,   90,   90,   90,
+       90,   90,   90,   90,   90,   90,   90,   90,   90,  113,
+
+      113,  113,  113,  113,  113,  113,  113,  113,  189,  189,
+      189,  189,  189,  189,  189,  189,  189,  189,  189,  189,
+      189,  204,  204,  204,  204,  204,  204,  204,  204,  204,
+      204,  204,  204,  204,  210,  210,  210,  210,  210, 1131,
+      210,  210,  210, 1131,  210, 1131,  210,  231,  231,  231,
+      231,  231,  231,  231,  231,  231,  231,  231,  231,  231,
+       99, 1131, 1131, 1131, 1131, 1131, 1131, 1131,   99,  249,
+      249, 1131,  249,  249, 1131,  249, 1131, 1131,  249,  249,
+     1131,  249,  336,  336,  336,  336,  340,  340,  340,  340,
+      340,  340,  340,  340,  340,  340,  340,  340,  340,  365,
+
+      365,  365,  365,  365,  365,  365,  365,  365,  365,  365,
+      365,  365,  371,  371,  371,  371,  371,  371,  371,  371,
+      371,  371,  371,  371,  371,  601,  601,  601, 1131,  601,
+      601,  601,  601,  601,  601,  601,  601,  601,  685, 1131,
+      685,  685,  685,  685,  685,  685,  685,  685,  685,  685,
+      685,  688, 1131,  688,  688,  688,  688,  688,  688,  688,
+      688,  688,  688,  688,  690,  690,  690,  690,  690,  690,
+      690,  690,  690,  690,  690,  690,  690,  693,  693,  693,
+      693,  693,  693,  693,  693,  693,  693,  693,  693,  693,
+      695,  695,  695,  695,  695,  695,  695,  695,  695,  695,
+
+      695,  695,  695,  702, 1131,  702,  702,  702,  702,  702,
+      702,  702,  702,  702,  702,  702,  778,  778,  778,  778,
+      778,  778,  778,  778,  778,  778,  778,  778,  778,  786,
+      786,  786,  786,  786,  786,  786,  786,  786,  786,  786,
+      786,  786,  789,  789,  789,  789,  789,  789,  789,  789,
+      789,  789,  789,  789,  789,  790, 1131,  790,  790,  790,
+      790,  790,  790,  790,  790,  790,  790,  790,  793, 1131,
+      793,  793,  793,  793,  793,  793,  793,  793,  793,  793,
+      793,  794,  794,  794,  794,  794,  794,  794,  794,  794,
+      794,  794,  794,  794,  796,  796,  796,  796,  796,  796,
+
+      796,  796,  796,  796,  796,  796,  796,  797,  797,  797,
+      797,  797,  797,  797,  797,  797,  797,  797,  797,  797,
+      800, 1131,  800,  800,  800,  800,  800,  800,  800,  800,
+      800,  800,  800,  861,  861,  861,  861,  861,  861,  861,
+      861,  861,  861,  861,  861,  861,  868,  868,  868,  868,
+      868,  868,  868,  868,  868,  868,  868,  868,  868,  870,
+      870,  870,  870,  870,  870,  870,  870,  870,  870,  870,
+      870,  870,  901,  901,  901,  901,  901,  901,  901,  901,
+      901,  901,  901,  901,  901,  954,  954,  954,  954,  954,
+      954,  954,  954,  954,  954,  954,  954,  954, 1069, 1069,
+
+     1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069, 1069,
+     1069,   13, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
+    } ;
+
+static yyconst flex_int16_t yy_chk[4102] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    2,
+        2,    2,    2,   74,    8,    8,    8,    8,   10,   15,
+
+       15,   15, 1083,   14,   16,   16,   16,    2,    2,    2,
+        2,    2,    2,    2,    2,    2,    2,   14,   70,   17,
+     1081,   10,   74,   70,    2,    2,   71,   75,    2,    8,
+        2,    8,   14,   17,   18,   19,   21,   15,   20,   22,
+      551,    2,    2,  551, 1069,   14,   22,   22,   17,   19,
+       10,   15,   20,    2,    2,   75,   80,    2,    8,    2,
+        8,   17,   84,   23,   19,   30,   15,   20,   18,    2,
+        2,   71,   24,   21,   26,   30,   22,   19,   81,   15,
+       20,   25,   18,  116,   23,   80,   24,   21,   26,   30,
+       22,   84,   28,   85,  100,   31, 1051,   18,   23,   71,
+
+      624,   24,   21,   26,   30,   22,   81,   25,  624,   31,
+       18,   32,  116,   23,   24,   21,   26,   30,   22,   28,
+       84,   25,  100, 1047,   31,   32,   23,   56,   56,   56,
+       76,   76,   76,   28,  101,  105,   25,   31,  106,   85,
+       32,  179,   69,   69,   69,   33, 1006,  179,   28,   25,
+       27,   33,   27,   32,   77,   77,   77,   78,   78,   78,
+     1000,   28,  101,  105,  914,   33,  106,   85,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   34,   69,
+       33,   35,   35,   27,  120,   35,   41,   27,   27,   27,
+      868,   35,   34,   33,   27,   41,   27,   27,   35,   35,
+
+       41,  862,   27,  123,   89,  861,   27,   34,   69,  796,
+       35,   35,   27,  120,   35,   41,   27,   27,   27,   35,
+       34,  114,   27,   41,   27,   27,   35,   35,   41,   88,
+       27,   36,  123,   42,   27,   29,   36,   29,   29,   29,
+       29,   29,   29,   29,   29,   29,   29,   42,  794,  114,
+       36,   90,  337,   89,  337,   29,   29,   29,   90,   90,
+       36,   88,   42,  115,  117,   36,  104,  786,   29,  121,
+      122,   29,  126,   44,  109,   42,  104,   54,   36,   38,
+       38,   89,   44,   38,   29,   29,   29,   44,  109,   38,
+       88,  115,  117,   38,   38,  104,   29,  121,  122,   29,
+
+       37,  126,   44,  109,  104,   37,   54,   37,   38,   38,
+       44,   37,   38,  785,   37,   44,  109,   38,   92,   37,
+       54,   38,   38,  778,   37,   92,   92,  660,  777,   37,
+      186,  186,  186,  660,   37,   54,   37,   43,  693,   37,
+      132,   45,   37,  692,   43,   43,   45,   37,   54,   45,
+      690,   43,   37,   39,  625,   45,   72,   72,   72,   39,
+       45,   39,   39,  625,   39,   39,   43,   39,   72,  132,
+       45,   39,   43,   43,  124,   45,  102,  689,   45,   43,
+      689,  678,   39,   45,  211,  211,  211,   39,   45,   39,
+       39,  102,   39,   39,   72,   39,  119,   49,   49,   39,
+
+       40,  664,  124,   40,  635,  102,   40,   40,   72,   40,
+       46,  753,   49,  119,   40,   40,  128,  143,   46,  102,
+      753,   46,   46,   72,   46,  119,   49,   49,  118,   40,
+       46,  558,   40,  103,   40,   40,   72,   40,  118,   46,
+       49,  119,   40,   40,  128,   47,  143,   46,  103,   46,
+       46,   48,   46,   47,  129,   47,   48,  118,   46,   47,
+       47,   52,  103,  130,  131,   48,  118,  133,   48,   52,
+       48,   48,  661,  553,   47,   52,  103,  534,  661,  134,
+       48,   47,  129,   47,  519,   48,  135,   47,   47,  137,
+       52,  130,  131,   48,   95,  133,   48,   52,   48,   48,
+
+       50,   95,   95,   52,   50,   50,   51,  134,   50,  496,
+       53,   51,   53,   51,  135,  487,   50,  137,  139,   50,
+       50,  140,   53,   51,   53,   51,  224,  224,  224,   50,
+      401,  399,  146,   50,   50,   51,  141,   50,  144,   53,
+       51,   53,   51,   95,   50,   60,  139,   50,   50,  140,
+       53,   51,   53,   51,   55,   55,   55,   55,   57,   57,
+       58,  146,   55,  392,  141,   58,  144,  338,  138,  338,
+      147,   95,   60,  390,  138,   57,   57,   57,   57,   57,
+       57,   57,   57,   57,   57,  148,   60,  149,  159,   55,
+       55,   65,   55,   55,   62,   55,  138,   58,  147,   65,
+
+       62,   60,  138,   62,   65,   65,   55,   55,   62,  365,
+      150,   58,  362,  148,   60,  340,  149,  159,   55,   55,
+       65,   55,   55,   62,   55,  151,   58,   65,   62,  336,
+      247,   62,   65,   65,   55,   55,   62,   63,  150,   58,
+       59,   91,   91,   91,   63,   63,   59,  244,  243,   91,
+       91,   63,  242,  151,   59,  241,   59,   59,   59,   59,
+       59,   59,   59,   59,   59,   59,   63,   99,   99,  142,
+       94,  142,   63,   63,   59,   59,   59,   94,   94,   63,
+       99,  152,  125,  125,  153,  154,  155,   59,  125,  157,
+       59,  161,  213,  511,  163,  511,   99,   99,  164,  210,
+
+      166,  127,   94,   59,   59,   59,  127,  170,   99,  152,
+      125,  125,  153,  154,  155,   59,  125,  157,   59,   61,
+      161,  142,  163,   61,   61,  204,  164,   61,  166,  860,
+      127,   94,  189,   61,  182,  127,  170,   61,   61,  158,
+       64,  178,  158,  136,  165,   64,  145,   64,   61,  142,
+      136,  165,   61,   61,  136,  171,   61,   64,  145,   64,
+      145,   61,  182,  145,   64,   61,   61,  158,   87,   64,
+      158,   86,  136,  165,   64,  145,   64,   82,  136,  165,
+       67,  512,  136,  512,  171,   64,  145,   64,  145,  860,
+       13,  145,   64,   73,   73,   73,   73,   73,   73,   73,
+
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   73,   73,   73,   73,   73,   73,   73,   73,
+       73,   73,   98,  110,   98,  110,    7,  156,  110,  110,
+      110,  110,  110,  110,  110,  110,  110,  110,  160,  366,
+
+      366,  366,  156,  183,  160,  172,  528,  168,  528,  169,
+      173,  174,    0,  169,  173,   98,  156,  185,  168,   98,
+      181,   98,  866,  530,  196,  530,   98,  160,   98,   98,
+      156,  183,  160,  162,  172,  162,  168,  169,   98,  173,
+      174,  169,    0,  173,   98,  185,  168,    0,   98,  181,
+       98,  162,  162,  196,   98,  162,   98,   98,  176,  199,
+      176,    0,  162,  191,  162,    0,   98,  108,  108,  108,
+      108,  108,  108,  108,  108,  108,  108,  167,  180,  162,
+      162,  184,  866,  162,  203,  108,  108,  199,  184,  192,
+      200,  167,  180,  193,  167,  191,  176,  231,  108,  202,
+
+        0,  207,  215,    0,  231,  231,  167,  180,    0,  184,
+      176,  187,  187,  203,  108,  108,  184,  208,  200,  167,
+      180,  192,  167,    0,  191,  176,  108,  202,  187,  187,
+      187,  187,  187,  187,  187,  187,  187,  187,  176,  188,
+      197,  651,  193,  651,  239,  188,  207,  197,  222,  208,
+      192,  215,  223,    0,    0,  188,  188,  188,  188,  188,
+      188,  188,  188,  188,  188,  194,  198,  198,  197,  214,
+      193,  194,  198,  239,  207,  197,  222,    0,  208,  215,
+      223,  194,  194,  194,  194,  194,  194,  194,  194,  194,
+      194,  195,  209,  225,  198,  198,  216,  195,    0,  240,
+
+      198,  214,  206,  206,  206,  195,  201,  195,  195,  195,
+      195,  195,  195,  195,  195,  195,  195,  226,  201,  246,
+      201,  225,  227,  201,  229,  195,  195,  209,  216,  221,
+      214,  221,    0,    0,  258,  201,  234,  240,  195,  206,
+      230,    0,  228,  234,  234,  226,  201,  246,  201,    0,
+      652,  201,  652,    0,  195,  195,  209,  216,  221,    0,
+      221,  245,  227,  258,    0,  240,  195,  229,  206,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  217,  217,
+      217,  217,  217,  217,  217,  217,  217,  217,  220,  219,
+      227,  228,  230,  248,  245,  229,  254,  255,  217,  217,
+
+      217,  217,  217,  219,  237,  220,  232,  232,  232,  256,
+      257,  237,  237,  259,  232,  232,    0,  220,  219,  228,
+      230,  248,  245,    0,  254,  255,  233,  233,  233,  217,
+      217,  219,    0,  220,  233,  233,  236,  256,  257,    0,
+      238,  259,  238,  236,  236,  238,  238,  238,  238,  238,
+      238,  238,  238,  238,  238,  260,  237,  217,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  218,  218,  218,
+      218,  218,  218,  218,  218,  218,  218,  261,  262,  236,
+      378,  378,  378,  260,  237,    0,    0,  218,  218,  218,
+      218,  218,  218,  251,  251,  251,  251,  251,  251,  251,
+
+      251,  251,  251,  263,  264,  261,  262,  236,  252,  252,
+      252,  252,  252,  252,  252,  252,  252,  252,  218,  218,
+      253,  218,  253,  547,  547,  547,    0,    0,  266,  267,
+      253,  263,  264,  265,  268,  269,  265,    0,  270,  271,
+      272,  273,  274,    0,    0,  266,  218,  250,  250,  250,
+      250,  250,  250,  250,  250,  250,  250,  266,  267,  277,
+      281,  265,  268,  269,  265,  250,  250,  270,  271,  272,
+      273,  274,  276,  266,  276,  282,  283,  278,  250,  278,
+        0,    0,  279,  279,  284,  285,  286,  285,  277,  281,
+      287,    0,  289,  290,  250,  250,  291,  292,  288,  293,
+
+      288,  295,    0,  276,  282,  283,  250,  275,  278,  275,
+      279,  279,  284,  294,  286,  299,  285,    0,  298,  287,
+      289,  290,    0,  300,  291,  292,  294,  293,  302,    0,
+      295,  296,  301,  296,  301,    0,  303,  297,  275,  297,
+      304,  296,  294,  275,  299,  275,  298,  297,  275,    0,
+      288,  300,  275,  306,  294,  275,  305,  302,  275,  275,
+      308,    0,  275,  301,  303,  309,  310,  312,  304,  313,
+      315,  311,  275,  316,  275,  296,  317,  275,  288,  311,
+      275,  297,  306,  275,  305,  296,  275,  275,  318,  308,
+      275,  297,  314,  309,  310,  319,  312,  313,  315,  311,
+
+      314,  316,  320,  296,  317,  321,  322,  311,  323,  297,
+      324,  325,  326,  296,  328,  329,  327,  318,  327,  297,
+      330,  314,  331,  332,  319,  333,  327,  334,  314,  335,
+      339,  320,  341,  321,  342,  322,  323,  343,  324,  325,
+      326,  344,  345,  328,  329,  346,  347,  352,  330,    0,
+      331,  332,    0,  333,  351,  334,  363,  335,  339,  348,
+      341,  348,  342,  353,    0,  343,  355,  356,  358,  344,
+      345,  357,  359,  346,  376,  347,  369,  348,  348,  348,
+      348,  348,  348,  348,  348,  348,  348,  349,  357,  869,
+      352,  361,  351,  349,  363,  355,  356,  358,  371,    0,
+
+      357,  359,  376,  349,  349,  349,  349,  349,  349,  349,
+      349,  349,  349,  350,  368,  353,  357,  370,  352,  350,
+      361,  351,  377,  363,  379,  383,    0,  371,  369,  350,
+      350,  350,  350,  350,  350,  350,  350,  350,  350, 1005,
+        0,  360,  372,  353,  354,  364,  364,  364,  381,  869,
+      354,  377,  379,  372,  360,  370,  369,  368,  354,  373,
+      354,  354,  354,  354,  354,  354,  354,  354,  354,  354,
+      360,  372,  374,  380,  384,  383,  382,  373,  354,  354,
+        0,  372,  360,  375,  370,  368,  364,  406,  373,  385,
+      398,  354,  374,  405,  375,  381,  385,  385,  653, 1005,
+
+      653,  374,  380,  383,    0,  373,  386,  354,  354,  382,
+      384,    0,  375,  386,  386,  364,  406,  387,  398,  354,
+      374,  405,  375,  381,  387,  387,  388,  388,  388,  388,
+      388,  388,  388,  388,  388,  388,  408,  410,  382,  384,
+      389,  389,  389,  389,  389,  389,  389,  389,  389,  389,
+      402,  411,  402,  387,  413,    0,  386,  414,    0,  415,
+      402,  416,  417,  418,  420,  408,  410,  421,  422,  423,
+      424,  425,  426,  429,  426,  430,  431,    0,  432,  411,
+      433,  435,  387,  413,  386,  436,  414,  415,  434,  416,
+      417,  439,  418,  420,  442,  421,  422,  423,  424,  425,
+
+      437,  429,  437,  430,  434,  431,  432,  444,  433,  435,
+      440,  446,  440,  426,  436,  447,  445,  434,  445,  439,
+      450,  448,  442,  448, 1009,  451,  452,  426,  454,    0,
+      457,  437,  434,  455,  456,  444,  458,  459,  460,  446,
+      464,  440,  426,  458,  447,  463,  468,  445,  467,  450,
+        0,  469,  448,  451,  452,  426,  427,  454,  427,  457,
+      470,  455,  456,    0,  480,  458,  459,  460,  461,  464,
+      461,  458,  465,  463,  465,  468,  467,  478,  461,  469,
+      483,  472,  465,  472, 1009,  479,  481,  427,  470,  482,
+      484,  475,  427,  480,  427,  485,  493,  427,  503,  475,
+
+      488,  427,    0,  489,  427,  478,  490,  427,  427,  483,
+      491,  427,  472,  479,  481,    0,    0,  482,  484,    0,
+      506,  427,  506,  427,  485,  493,  427,  503,  488,  427,
+      475,  489,  427,  499,  490,  427,  427,    0,  491,  427,
+      443,  443,  443,  443,  443,  443,  443,  443,  443,  443,
+      443,  506,  443,  443,  443,  443,  443,  443,  443,  475,
+      507,  499,  508,  509,  494,  500,  494,  500,  513,  443,
+      443,  443,  443,  443,  494,  500,  514,  515,  516,  517,
+      518,  523,  524,  655,  535,  655,  525,    0,  667,  507,
+      667,  508,  509,  520,  529,  520,  527,  513,  563, 1031,
+
+      443,  443,  529,  540,  514,  531,  515,  516,  517,  518,
+      537,  520,  520,  520,  520,  520,  520,  520,  520,  520,
+      520,  521,  525,  529,  527,  545,  563,  521,  443,  565,
+      523,  529,  524,  535,  531,    0,    0,  521,  521,  521,
+      521,  521,  521,  521,  521,  521,  521,  522,    0,  538,
+      539,  525,  540,  522,  545,  537,  568,  565,  523, 1031,
+      524,  535,    0,  522,  522,  522,  522,  522,  522,  522,
+      522,  522,  522,  526,  532,  536,  536,  536,    0,  526,
+      540,  532,  548,  537,  568,  532,  539,  526,  541,  526,
+      526,  526,  526,  526,  526,  526,  526,  526,  526,  538,
+
+      533,    0,  533,  532,  552,  550,  541,  526,  526,  532,
+      533,  548,  561,  532,  533,  539,  536,  541,  542,    0,
+      526,  543,  542,  554,  544,  543,  562,  538,  544,  566,
+      554,  554,  569,  576,  541,  555,  526,  526,  550,  577,
+      552,  561,  555,  555,  570,  536,  571,  542,  526,  573,
+      543,  542,  574,  544,  543,  562,  575,  544,  566,  554,
+        0,  569,  576,  581,  659,  659,  659,  550,  577,  552,
+        0,  578,  570,  578,  571,    0,  641,  573,  641,  579,
+      574,  580,    0,  582,  575,  583,  641,  584,  554,  564,
+      564,  581,  564,  564,  564,  564,  564,  564,  564,  564,
+
+      564,  564,  564,  564,  564,  564,  564,  564,  579,  585,
+      580,  582,  578,  586,  583,  584,  587,  588,  564,  564,
+      564,  564,  564,  590,  592,    0,  578,  593,  594,  586,
+      595,    0,  596,  597,  598,  608,  599,  585,  599,    0,
+      602,  578,  586,  603,  587,  603,  588,  607,  613,  564,
+      564,  590,  610,  592,  578,  593,  594,  586,  611,  595,
+      596,  614,  597,  598,  608,  615,  616,  599,  602,  617,
+      618,    0,  619,  620,  603,  607,  613,  564,  621,  622,
+      623,  610,  626,    0,  627,  628,  630,  611,  632,  633,
+      614,  634,  639,  615,  616,  636,  637,  638,  617,  618,
+
+      619,  640,  620,  644,  645,  646,  621,  646,  622,  623,
+      654,  626,  627,  656,  628,  630,  632,  657,  633,  662,
+      634,  639,  663,  636,  637,  638,  666,  668,  669,  640,
+      669,  644,  645,  658,  670,  658,  646,  671,  672,  654,
+      672,  676,  656,  658,  681,  657,  675,  658,  672,  674,
+      683,  674,  672,  679,  677,  666,  668,  700,  663,  662,
+      694,    0,  670,  674,  695,  680,  671,  694,  694,  680,
+      696,  695,  695,  681,  701,  703,    0,  696,  696,  683,
+      771,  738,  771,  738, 1082,  700,  675,  663,  662,  665,
+      677,  738,  676,  679,  680,  665,    0,  704,  680,  706,
+
+      707,  708,  701,  665,  703,  665,  665,  665,  665,  665,
+      665,  665,  665,  665,  665,  675,  709,    0,  710,  677,
+      676,  711,  679,  665,  665,  704,  714,  706,  707,  708,
+      715,  717,    0,  719,  721,    0,  665,  762,    0,  762,
+      770,  781,  770,  781, 1082,  709,  710,  762,  770,  858,
+      711,  858,  665,  665,  712,  714,  712,  722,  723,  715,
+      717,  719,  724,  721,  665,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  682,  682,  682,  682,  682,  682,
+      682,  682,  682,  682,  725,  722,  723,  726,  727,  712,
+      729,  724,  728,  730,  682,  682,  682,  682,  682,  731,
+
+      732,    0,  712,  733,  734,  735,  737,  735, 1084,  739,
+      740,  741,  725,  742,    0,  743,  726,  727,  712,  729,
+      728,  745,  730,  746,  752,  682,  682,  731,  756,  732,
+      712,  733,  734,    0,    0,  737,  735,  739,    0,  740,
+      741,  755,  742,  743,  757,  775,  775,  775,  833,  745,
+      833,  746,  752,  682,  686,  686,  686,  756,  833,  686,
+      686,  751,  686,  751,    0,    0,  686,  686, 1084,  755,
+      686,    0,  757,  686,  686,  686,  686,  686,  686,  686,
+      686,  686,  699,  699,  776,  699,  699,  699,  699,  699,
+      699,  699,  699,  699,  699,  699,  699,  699,  699,  699,
+
+      699,  758,  759,  783,  760,  763,    0,  768,  773,  751,
+      772,  699,  699,  699,  699,  699,  767,  774,  767,  779,
+      782,  776,  784,  787,  780,  789,  791,  791,  791,  758,
+      802,  759,  760,  810,  763,  768,  773,  751,  803,  772,
+      783,    0,  699,  699,  804,  806,  774,  807,  779,  782,
+      776,  767,  780,  808,  789,  797,  812,  798,  784,  802,
+      787,  810,  797,  797,  798,  798,  864,  803,  864,  783,
+      699,    0,    0,  804,  806,    0,  807,  811,    0,  811,
+      767,  801,  808,  813,  812,  801,  815,  784,  816,  787,
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  788,
+
+      788,  788,  788,  788,  788,  788,  788,  788,  788,  817,
+      801,  813,  811,  819,  801,  815,  816,  818,  820,  788,
+      788,  788,  788,  788,  821,  811,  822,    0,  823,  824,
+      825,  826,  827,    0,  828,  830,  831,  840,  817,  832,
+     1085,  811,  819,  835,  836,  818,  842,  820,  842,  843,
+      788,  788,  821,  811,  844,  822,  823,  824,  825,  826,
+      846,  827,  828,  847,  830,  831,  840,  832,  834,  834,
+      834,  835,  836,  851,  852,  851,  834,  843,  788,  834,
+      853,  855,  844,  851,  854,  856,  854,  857,  846,  859,
+      867,  865,  847,  863,  842,  870,  871,    0,  873,  874,
+
+     1085,  875,  876,  852,  878,  879,  880,  881,  853,  882,
+      855,  883,    0,  884,  856,  857,  885,  889,  859,  854,
+      865,  863,  842,  886,  870,  871,  873,  887,  874,  875,
+      876,  888,  878,  879,  880,  881,  890,  882,  896,  867,
+      883,  884,  892,  893,  894,  885,  889,  895,  854,  897,
+      899,  886,  901,  901,  901,  887,  903,  903,  903,  888,
+      901,  909,    0,  901,  890,  910,  896,  867,    0,  908,
+      915,  892,  893,  894,  913,  916,  895,  897,  899,  902,
+      902,  902,  917,  904,  904,  904,  918,  902,  919,  909,
+      902,  904,  920,  910,  904,  905,  905,  905,  908,  915,
+
+      921,  922,  913,  905,  916,  924,  905,  925,  926,  927,
+      917,  928,  929,  932,  918,    0,  919,  933,    0,  935,
+      936,  920,  937,  938,  939,  941,  940,  942,  940,  943,
+      922,  944,  945,  947,  924,  921,  940,  949,  951,  928,
+      929,  932,  952,  925,  927,  926,  933,  935,    0,  936,
+      937,    0,  938,  939,  941,  961,  942,  960,  943,  944,
+      945,  947,    0,    0,  921,  949,  951,  953,  953,  953,
+      965,  952,  925,  927,  926,  954,  954,  954,  970,  955,
+      955,  955,  963,  954,  961,  960,  954,  955,  966,  973,
+      955,  956,  956,  956,  967,  957,  957,  957,  965,  956,
+
+      969,  975,  956,  957,  971,  974,  957,  958,  958,  958,
+      976,  963,  977,  980,  977,  958,  981,  966,  958,    0,
+      982,  983,  977,  967,  970,  984,  985,  984,  985,  969,
+      987,  989,  971,  991,  973,  984,  985,  974,  994,  976,
+      992,  980,  995, 1008, 1007,  981,    0,  975,  982,  998,
+      983,    0,  970,  996,  996,  996,  999, 1001,  987,  989,
+     1013,  991,  973, 1016, 1014, 1015,  974,  994,  992, 1017,
+     1019,  995,  997,  997,  997,  975, 1021, 1008,  998, 1007,
+      997, 1032, 1011,  997, 1011,  999, 1001, 1012, 1013, 1012,
+     1025, 1016, 1011, 1014, 1015, 1026, 1029, 1017, 1027, 1019,
+
+     1012, 1030, 1012, 1033, 1021, 1037, 1008, 1036, 1007, 1023,
+     1023, 1023, 1024, 1024, 1024,    0, 1038, 1032, 1012, 1025,
+     1024, 1039, 1042, 1024, 1026, 1034, 1027, 1034, 1045, 1030,
+     1041, 1048, 1035, 1037, 1035, 1052, 1036, 1046, 1034, 1050,
+     1034, 1029, 1056, 1035, 1038, 1035, 1032, 1035, 1033, 1059,
+     1039, 1042, 1043, 1043, 1043, 1049, 1034, 1045, 1041, 1044,
+     1044, 1044, 1053, 1035, 1053, 1046, 1055, 1044, 1058, 1029,
+     1044, 1056, 1063, 1053, 1050, 1068, 1033, 1048, 1059, 1064,
+     1065, 1052,    0, 1049, 1062, 1062, 1062, 1066, 1071, 1067,
+        0, 1073, 1062,    0, 1055, 1062, 1058, 1074,    0, 1079,
+
+     1063, 1099, 1109, 1050, 1093, 1048,    0, 1064, 1065, 1052,
+     1061, 1061, 1061, 1095,    0, 1061, 1061, 1067, 1061, 1073,
+     1086, 1068, 1061, 1061, 1080, 1074, 1061, 1079, 1090, 1061,
+     1061, 1061, 1061, 1061, 1061, 1061, 1061, 1061, 1066, 1071,
+     1076, 1076, 1076, 1077, 1077, 1077,    0, 1094, 1086, 1068,
+     1099, 1077, 1096, 1080, 1077, 1093, 1104, 1090, 1095, 1101,
+     1102, 1105, 1109,    0, 1111,    0, 1066, 1071, 1078, 1078,
+     1078, 1100, 1113, 1078, 1078, 1094, 1078, 1103, 1099, 1078,
+     1078, 1078, 1106, 1093, 1078, 1104, 1095, 1078, 1078, 1078,
+     1078, 1078, 1078, 1078, 1078, 1078, 1088, 1088, 1088, 1100,
+
+     1089, 1089, 1089, 1096, 1088, 1101, 1107, 1088, 1089, 1102,
+     1108, 1089, 1105, 1103, 1110, 1111, 1112, 1114, 1106, 1115,
+     1115, 1115, 1117, 1113, 1116, 1116, 1116, 1118, 1118, 1118,
+     1123, 1096, 1126, 1101, 1119, 1119, 1119, 1102, 1107, 1108,
+     1105, 1127, 1103, 1111, 1112,    0, 1110, 1106, 1121, 1121,
+     1121, 1113, 1124, 1124, 1124, 1128, 1128, 1128, 1129, 1129,
+     1129,    0,    0,    0, 1126,    0, 1123, 1107, 1114,    0,
+        0, 1117,    0,    0,    0, 1110,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0, 1127, 1126,    0, 1123, 1114,    0,    0, 1117,
+
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+        0,    0,    0,    0,    0,    0,    0,    0,    0,    0,
+     1127, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132,
+     1132, 1132, 1132, 1132, 1133, 1133, 1133, 1133, 1133, 1133,
+     1133, 1133, 1133, 1133, 1133, 1133, 1133, 1134,    0, 1134,
+     1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134,
+     1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135, 1135,
+     1135, 1135, 1135, 1136, 1136, 1136, 1136, 1136, 1136, 1136,
+     1136, 1136, 1136, 1136, 1136, 1136, 1137, 1137, 1137, 1137,
+     1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1137, 1138,
+
+     1138, 1138, 1138, 1138, 1138, 1138, 1138, 1138, 1139, 1139,
+     1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139,
+     1139, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140, 1140,
+     1140, 1140, 1140, 1140, 1141, 1141, 1141, 1141, 1141,    0,
+     1141, 1141, 1141,    0, 1141,    0, 1141, 1142, 1142, 1142,
+     1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142, 1142,
+     1143,    0,    0,    0,    0,    0,    0,    0, 1143, 1144,
+     1144,    0, 1144, 1144,    0, 1144,    0,    0, 1144, 1144,
+        0, 1144, 1145, 1145, 1145, 1145, 1146, 1146, 1146, 1146,
+     1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1146, 1147,
+
+     1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147, 1147,
+     1147, 1147, 1148, 1148, 1148, 1148, 1148, 1148, 1148, 1148,
+     1148, 1148, 1148, 1148, 1148, 1149, 1149, 1149,    0, 1149,
+     1149, 1149, 1149, 1149, 1149, 1149, 1149, 1149, 1150,    0,
+     1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150,
+     1150, 1151,    0, 1151, 1151, 1151, 1151, 1151, 1151, 1151,
+     1151, 1151, 1151, 1151, 1152, 1152, 1152, 1152, 1152, 1152,
+     1152, 1152, 1152, 1152, 1152, 1152, 1152, 1153, 1153, 1153,
+     1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153, 1153,
+     1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154, 1154,
+
+     1154, 1154, 1154, 1155,    0, 1155, 1155, 1155, 1155, 1155,
+     1155, 1155, 1155, 1155, 1155, 1155, 1156, 1156, 1156, 1156,
+     1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1156, 1157,
+     1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157, 1157,
+     1157, 1157, 1158, 1158, 1158, 1158, 1158, 1158, 1158, 1158,
+     1158, 1158, 1158, 1158, 1158, 1159,    0, 1159, 1159, 1159,
+     1159, 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1160,    0,
+     1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160, 1160,
+     1160, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161, 1161,
+     1161, 1161, 1161, 1161, 1162, 1162, 1162, 1162, 1162, 1162,
+
+     1162, 1162, 1162, 1162, 1162, 1162, 1162, 1163, 1163, 1163,
+     1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163, 1163,
+     1164,    0, 1164, 1164, 1164, 1164, 1164, 1164, 1164, 1164,
+     1164, 1164, 1164, 1165, 1165, 1165, 1165, 1165, 1165, 1165,
+     1165, 1165, 1165, 1165, 1165, 1165, 1166, 1166, 1166, 1166,
+     1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1166, 1167,
+     1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167, 1167,
+     1167, 1167, 1168, 1168, 1168, 1168, 1168, 1168, 1168, 1168,
+     1168, 1168, 1168, 1168, 1168, 1169, 1169, 1169, 1169, 1169,
+     1169, 1169, 1169, 1169, 1169, 1169, 1169, 1169, 1170, 1170,
+
+     1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170, 1170,
+     1170, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+     1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131, 1131,
+
+     1131
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int fortran__flex_debug;
+int fortran__flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *fortran_text;
+#line 1 "fortran.lex"
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+
+
+
+
+#line 44 "fortran.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+extern FILE * fortran_in;
+#define MAX_INCLUDE_DEPTH 30
+YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
+int line_num_input = 1;
+int newlinef90 = 0;
+char tmpc;
+#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
+
+/******************************************************************************/
+/**************PETITS PB NON PREVUS *******************************************/
+/******************************************************************************/
+/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
+/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
+/*            de la 7eme et le debut de la ligne de commande                  */
+/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
+/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
+/******************************************************************************/
+#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+
+void out_of_donottreat(void);
+
+#line 1826 "fortran.yy.c"
+
+#define INITIAL 0
+#define parameter 1
+#define character 2
+#define donottreat 3
+#define fortran77style 4
+#define fortran90style 5
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+   These are made visible to non-reentrant scanners for convenience. */
+
+int fortran_lex_destroy (void );
+
+int fortran_get_debug (void );
+
+void fortran_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE fortran_get_extra (void );
+
+void fortran_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *fortran_get_in (void );
+
+void fortran_set_in  (FILE * in_str  );
+
+FILE *fortran_get_out (void );
+
+void fortran_set_out  (FILE * out_str  );
+
+yy_size_t fortran_get_leng (void );
+
+char *fortran_get_text (void );
+
+int fortran_get_lineno (void );
+
+void fortran_set_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int fortran_wrap (void );
+#else
+extern int fortran_wrap (void );
+#endif
+#endif
+
+    static void yyunput (int c,char *buf_ptr  );
+    
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( fortran_text, fortran_leng, 1, fortran_out )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+		{ \
+		int c = '*'; \
+		yy_size_t n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( fortran_in )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( fortran_in ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, fortran_in))==0 && ferror(fortran_in)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(fortran_in); \
+			} \
+		}\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int fortran_lex (void);
+
+#define YY_DECL int fortran_lex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after fortran_text and fortran_leng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	if ( fortran_leng > 0 ) \
+		YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \
+				(fortran_text[fortran_leng - 1] == '\n'); \
+	YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+    
+#line 97 "fortran.lex"
+
+  if (infixed) BEGIN(fortran77style) ;
+  if (infree)  BEGIN(fortran90style) ;
+
+#line 2021 "fortran.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! (yy_start) )
+			(yy_start) = 1;	/* first start state */
+
+		if ( ! fortran_in )
+			fortran_in = stdin;
+
+		if ( ! fortran_out )
+			fortran_out = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			fortran_ensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				fortran__create_buffer(fortran_in,YY_BUF_SIZE );
+		}
+
+		fortran__load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of fortran_text. */
+		*yy_cp = (yy_hold_char);
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = (yy_start);
+		yy_current_state += YY_AT_BOL();
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 1132 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 4012 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 101 "fortran.lex"
+{ return TOK_REAL8; }
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 102 "fortran.lex"
+{ return TOK_SUBROUTINE; }
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 103 "fortran.lex"
+{ return TOK_PROGRAM; }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 104 "fortran.lex"
+{ inallocate = 1; return TOK_ALLOCATE; }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 105 "fortran.lex"
+{ return TOK_NULLIFY; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 106 "fortran.lex"
+{ return TOK_NULL_PTR; }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 107 "fortran.lex"
+{ inallocate = 1; return TOK_DEALLOCATE; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 108 "fortran.lex"
+{ return TOK_RESULT; }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 109 "fortran.lex"
+{ return TOK_FUNCTION; }
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 110 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 111 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 112 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
+	YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 113 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 114 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 115 "fortran.lex"
+{ pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
+	YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 116 "fortran.lex"
+{ strcpy(yylval.na,fortran_text);
+                              tmpc = (char) input(); unput(tmpc);
+                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
+                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
+                              else                                    return TOK_NAME;
+                            }
+	YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 122 "fortran.lex"
+{ return TOK_REWIND; }
+	YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 123 "fortran.lex"
+{ return TOK_IMPLICIT; }
+	YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 124 "fortran.lex"
+{ return TOK_NONE; }
+	YY_BREAK
+case 20:
+YY_RULE_SETUP
+#line 125 "fortran.lex"
+{ return TOK_CALL; }
+	YY_BREAK
+case 21:
+YY_RULE_SETUP
+#line 126 "fortran.lex"
+{ return TOK_TRUE; }
+	YY_BREAK
+case 22:
+YY_RULE_SETUP
+#line 127 "fortran.lex"
+{ return TOK_FALSE; }
+	YY_BREAK
+case 23:
+YY_RULE_SETUP
+#line 128 "fortran.lex"
+{ return TOK_POINT_TO; }
+	YY_BREAK
+case 24:
+YY_RULE_SETUP
+#line 129 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
+	YY_BREAK
+case 25:
+YY_RULE_SETUP
+#line 130 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DASTER; }
+	YY_BREAK
+case 26:
+YY_RULE_SETUP
+#line 131 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQV; }
+	YY_BREAK
+case 27:
+YY_RULE_SETUP
+#line 132 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+	YY_BREAK
+case 28:
+YY_RULE_SETUP
+#line 133 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GT;  }
+	YY_BREAK
+case 29:
+YY_RULE_SETUP
+#line 134 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_GE;  }
+	YY_BREAK
+case 30:
+YY_RULE_SETUP
+#line 135 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LT;  }
+	YY_BREAK
+case 31:
+YY_RULE_SETUP
+#line 136 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LE;  }
+	YY_BREAK
+case 32:
+YY_RULE_SETUP
+#line 137 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+	YY_BREAK
+case 33:
+YY_RULE_SETUP
+#line 138 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NE;  }
+	YY_BREAK
+case 34:
+YY_RULE_SETUP
+#line 139 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NOT; }
+	YY_BREAK
+case 35:
+YY_RULE_SETUP
+#line 140 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OR;  }
+	YY_BREAK
+case 36:
+YY_RULE_SETUP
+#line 141 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_XOR; }
+	YY_BREAK
+case 37:
+YY_RULE_SETUP
+#line 142 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_AND; }
+	YY_BREAK
+case 38:
+YY_RULE_SETUP
+#line 143 "fortran.lex"
+{ return TOK_MODULE; }
+	YY_BREAK
+case 39:
+YY_RULE_SETUP
+#line 144 "fortran.lex"
+{ return TOK_WHILE; }
+	YY_BREAK
+case 40:
+YY_RULE_SETUP
+#line 145 "fortran.lex"
+{ return TOK_CONCURRENT; }
+	YY_BREAK
+case 41:
+YY_RULE_SETUP
+#line 146 "fortran.lex"
+{ return TOK_ENDDO; }
+	YY_BREAK
+case 42:
+YY_RULE_SETUP
+#line 147 "fortran.lex"
+{ return TOK_PLAINDO;}
+	YY_BREAK
+case 43:
+YY_RULE_SETUP
+#line 148 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_REAL; }
+	YY_BREAK
+case 44:
+YY_RULE_SETUP
+#line 149 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
+	YY_BREAK
+case 45:
+YY_RULE_SETUP
+#line 150 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_LOGICAL; }
+	YY_BREAK
+case 46:
+YY_RULE_SETUP
+#line 151 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_CHARACTER; }
+	YY_BREAK
+case 47:
+YY_RULE_SETUP
+#line 152 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_HEXA;}
+	YY_BREAK
+case 48:
+YY_RULE_SETUP
+#line 153 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
+	YY_BREAK
+case 49:
+YY_RULE_SETUP
+#line 154 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
+	YY_BREAK
+case 50:
+YY_RULE_SETUP
+#line 155 "fortran.lex"
+{ return TOK_COMPLEX; }
+	YY_BREAK
+case 51:
+YY_RULE_SETUP
+#line 156 "fortran.lex"
+{ return TOK_ALLOCATABLE; }
+	YY_BREAK
+case 52:
+YY_RULE_SETUP
+#line 157 "fortran.lex"
+{ return TOK_CLOSE; }
+	YY_BREAK
+case 53:
+YY_RULE_SETUP
+#line 158 "fortran.lex"
+{ return TOK_INQUIRE; }
+	YY_BREAK
+case 54:
+YY_RULE_SETUP
+#line 159 "fortran.lex"
+{ return TOK_DIMENSION; }
+	YY_BREAK
+case 55:
+YY_RULE_SETUP
+#line 160 "fortran.lex"
+{ return TOK_PAUSE; }
+	YY_BREAK
+case 56:
+YY_RULE_SETUP
+#line 161 "fortran.lex"
+{ return TOK_EQUIVALENCE; }
+	YY_BREAK
+case 57:
+YY_RULE_SETUP
+#line 162 "fortran.lex"
+{ return TOK_STOP; }
+	YY_BREAK
+case 58:
+YY_RULE_SETUP
+#line 163 "fortran.lex"
+{ return TOK_WHERE; }
+	YY_BREAK
+case 59:
+YY_RULE_SETUP
+#line 164 "fortran.lex"
+{ return TOK_ENDWHERE; }
+	YY_BREAK
+case 60:
+YY_RULE_SETUP
+#line 165 "fortran.lex"
+{ return TOK_ELSEWHEREPAR; }
+	YY_BREAK
+case 61:
+YY_RULE_SETUP
+#line 166 "fortran.lex"
+{ return TOK_ELSEWHERE; }
+	YY_BREAK
+case 62:
+YY_RULE_SETUP
+#line 167 "fortran.lex"
+{ return TOK_CONTAINS; }
+	YY_BREAK
+case 63:
+YY_RULE_SETUP
+#line 168 "fortran.lex"
+{ return TOK_ONLY; }
+	YY_BREAK
+case 64:
+YY_RULE_SETUP
+#line 169 "fortran.lex"
+{ return TOK_PARAMETER; }
+	YY_BREAK
+case 65:
+YY_RULE_SETUP
+#line 170 "fortran.lex"
+{ return TOK_RECURSIVE; }
+	YY_BREAK
+case 66:
+YY_RULE_SETUP
+#line 171 "fortran.lex"
+{ return TOK_COMMON; }
+	YY_BREAK
+case 67:
+YY_RULE_SETUP
+#line 172 "fortran.lex"
+{ return TOK_GLOBAL; }
+	YY_BREAK
+case 68:
+YY_RULE_SETUP
+#line 173 "fortran.lex"
+{ return TOK_EXTERNAL; }
+	YY_BREAK
+case 69:
+YY_RULE_SETUP
+#line 174 "fortran.lex"
+{ return TOK_INTENT; }
+	YY_BREAK
+case 70:
+YY_RULE_SETUP
+#line 175 "fortran.lex"
+{ return TOK_POINTER; }
+	YY_BREAK
+case 71:
+YY_RULE_SETUP
+#line 176 "fortran.lex"
+{ return TOK_OPTIONAL; }
+	YY_BREAK
+case 72:
+YY_RULE_SETUP
+#line 177 "fortran.lex"
+{ return TOK_SAVE; }
+	YY_BREAK
+case 73:
+YY_RULE_SETUP
+#line 178 "fortran.lex"
+{ pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
+	YY_BREAK
+case 74:
+YY_RULE_SETUP
+#line 179 "fortran.lex"
+{ return TOK_TYPE; }
+	YY_BREAK
+case 75:
+YY_RULE_SETUP
+#line 180 "fortran.lex"
+{ return TOK_ENDTYPE; }
+	YY_BREAK
+case 76:
+YY_RULE_SETUP
+#line 181 "fortran.lex"
+{ if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
+	YY_BREAK
+case 77:
+YY_RULE_SETUP
+#line 182 "fortran.lex"
+{ return TOK_OPEN; }
+	YY_BREAK
+case 78:
+YY_RULE_SETUP
+#line 183 "fortran.lex"
+{ return TOK_RETURN; }
+	YY_BREAK
+case 79:
+/* rule 79 can match eol */
+YY_RULE_SETUP
+#line 184 "fortran.lex"
+{ return TOK_EXIT; }
+	YY_BREAK
+case 80:
+YY_RULE_SETUP
+#line 185 "fortran.lex"
+{ return TOK_PRINT; }
+	YY_BREAK
+case 81:
+YY_RULE_SETUP
+#line 186 "fortran.lex"
+{ return TOK_PROCEDURE; }
+	YY_BREAK
+case 82:
+YY_RULE_SETUP
+#line 187 "fortran.lex"
+{ return TOK_READ; }
+	YY_BREAK
+case 83:
+YY_RULE_SETUP
+#line 188 "fortran.lex"
+{ return TOK_NAMELIST; }
+	YY_BREAK
+case 84:
+YY_RULE_SETUP
+#line 189 "fortran.lex"
+{ return TOK_WRITE; }
+	YY_BREAK
+case 85:
+YY_RULE_SETUP
+#line 190 "fortran.lex"
+{ return TOK_FLUSH; }
+	YY_BREAK
+case 86:
+YY_RULE_SETUP
+#line 191 "fortran.lex"
+{ return TOK_TARGET; }
+	YY_BREAK
+case 87:
+YY_RULE_SETUP
+#line 192 "fortran.lex"
+{ return TOK_PUBLIC; }
+	YY_BREAK
+case 88:
+YY_RULE_SETUP
+#line 193 "fortran.lex"
+{ return TOK_PRIVATE; }
+	YY_BREAK
+case 89:
+YY_RULE_SETUP
+#line 194 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_IN; }
+	YY_BREAK
+case 90:
+YY_RULE_SETUP
+#line 195 "fortran.lex"
+{ pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
+	YY_BREAK
+case 91:
+YY_RULE_SETUP
+#line 196 "fortran.lex"
+{ return TOK_CONTINUE; }
+	YY_BREAK
+case 92:
+YY_RULE_SETUP
+#line 197 "fortran.lex"
+{ return TOK_PLAINGOTO; }
+	YY_BREAK
+case 93:
+YY_RULE_SETUP
+#line 198 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_OUT; }
+	YY_BREAK
+case 94:
+YY_RULE_SETUP
+#line 199 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+	YY_BREAK
+case 95:
+YY_RULE_SETUP
+#line 200 "fortran.lex"
+{ return TOK_INTRINSIC; }
+	YY_BREAK
+case 96:
+YY_RULE_SETUP
+#line 201 "fortran.lex"
+{ return TOK_THEN; }
+	YY_BREAK
+case 97:
+YY_RULE_SETUP
+#line 202 "fortran.lex"
+{ return TOK_ELSEIF; }
+	YY_BREAK
+case 98:
+YY_RULE_SETUP
+#line 203 "fortran.lex"
+{ return TOK_ELSE; }
+	YY_BREAK
+case 99:
+YY_RULE_SETUP
+#line 204 "fortran.lex"
+{ return TOK_ENDIF; }
+	YY_BREAK
+case 100:
+YY_RULE_SETUP
+#line 205 "fortran.lex"
+{ return TOK_LOGICALIF; }
+	YY_BREAK
+case 101:
+YY_RULE_SETUP
+#line 206 "fortran.lex"
+{ return TOK_SUM; }
+	YY_BREAK
+case 102:
+YY_RULE_SETUP
+#line 207 "fortran.lex"
+{ return TOK_MAX; }
+	YY_BREAK
+case 103:
+YY_RULE_SETUP
+#line 208 "fortran.lex"
+{ return TOK_TANH; }
+	YY_BREAK
+case 104:
+YY_RULE_SETUP
+#line 209 "fortran.lex"
+{ return TOK_MAXVAL; }
+	YY_BREAK
+case 105:
+YY_RULE_SETUP
+#line 210 "fortran.lex"
+{ return TOK_TRIM; }
+	YY_BREAK
+case 106:
+YY_RULE_SETUP
+#line 211 "fortran.lex"
+{ return TOK_SQRT; }
+	YY_BREAK
+case 107:
+YY_RULE_SETUP
+#line 212 "fortran.lex"
+{ return TOK_SELECTCASE; }
+	YY_BREAK
+case 108:
+YY_RULE_SETUP
+#line 213 "fortran.lex"
+{ return TOK_CASE; }
+	YY_BREAK
+case 109:
+YY_RULE_SETUP
+#line 214 "fortran.lex"
+{ return TOK_DEFAULT; }
+	YY_BREAK
+case 110:
+YY_RULE_SETUP
+#line 215 "fortran.lex"
+{ return TOK_ENDSELECT; }
+	YY_BREAK
+case 111:
+YY_RULE_SETUP
+#line 216 "fortran.lex"
+{ return TOK_FILE; }
+	YY_BREAK
+case 112:
+YY_RULE_SETUP
+#line 217 "fortran.lex"
+{ return TOK_UNIT; }
+	YY_BREAK
+case 113:
+YY_RULE_SETUP
+#line 218 "fortran.lex"
+{ return TOK_FMT; }
+	YY_BREAK
+case 114:
+YY_RULE_SETUP
+#line 219 "fortran.lex"
+{ return TOK_NML; }
+	YY_BREAK
+case 115:
+YY_RULE_SETUP
+#line 220 "fortran.lex"
+{ return TOK_END; }
+	YY_BREAK
+case 116:
+YY_RULE_SETUP
+#line 221 "fortran.lex"
+{ return TOK_EOR; }
+	YY_BREAK
+case 117:
+YY_RULE_SETUP
+#line 222 "fortran.lex"
+{ return TOK_ERR; }
+	YY_BREAK
+case 118:
+YY_RULE_SETUP
+#line 223 "fortran.lex"
+{ return TOK_EXIST; }
+	YY_BREAK
+case 119:
+YY_RULE_SETUP
+#line 224 "fortran.lex"
+{ return TOK_MIN; }
+	YY_BREAK
+case 120:
+YY_RULE_SETUP
+#line 225 "fortran.lex"
+{ return TOK_NINT; }
+	YY_BREAK
+case 121:
+YY_RULE_SETUP
+#line 226 "fortran.lex"
+{ return TOK_FLOAT; }
+	YY_BREAK
+case 122:
+YY_RULE_SETUP
+#line 227 "fortran.lex"
+{ return TOK_EXP; }
+	YY_BREAK
+case 123:
+YY_RULE_SETUP
+#line 228 "fortran.lex"
+{ return TOK_COS; }
+	YY_BREAK
+case 124:
+YY_RULE_SETUP
+#line 229 "fortran.lex"
+{ return TOK_COSH; }
+	YY_BREAK
+case 125:
+YY_RULE_SETUP
+#line 230 "fortran.lex"
+{ return TOK_ACOS; }
+	YY_BREAK
+case 126:
+YY_RULE_SETUP
+#line 231 "fortran.lex"
+{ return TOK_SIN; }
+	YY_BREAK
+case 127:
+YY_RULE_SETUP
+#line 232 "fortran.lex"
+{ return TOK_SINH; }
+	YY_BREAK
+case 128:
+YY_RULE_SETUP
+#line 233 "fortran.lex"
+{ return TOK_ASIN; }
+	YY_BREAK
+case 129:
+YY_RULE_SETUP
+#line 234 "fortran.lex"
+{ return TOK_LOG; }
+	YY_BREAK
+case 130:
+YY_RULE_SETUP
+#line 235 "fortran.lex"
+{ return TOK_TAN; }
+	YY_BREAK
+case 131:
+YY_RULE_SETUP
+#line 236 "fortran.lex"
+{ return TOK_ATAN; }
+	YY_BREAK
+case 132:
+YY_RULE_SETUP
+#line 237 "fortran.lex"
+{ return TOK_CYCLE; }
+	YY_BREAK
+case 133:
+YY_RULE_SETUP
+#line 238 "fortran.lex"
+{ return TOK_ABS; }
+	YY_BREAK
+case 134:
+YY_RULE_SETUP
+#line 239 "fortran.lex"
+{ return TOK_MOD; }
+	YY_BREAK
+case 135:
+YY_RULE_SETUP
+#line 240 "fortran.lex"
+{ return TOK_SIGN; }
+	YY_BREAK
+case 136:
+YY_RULE_SETUP
+#line 241 "fortran.lex"
+{ return TOK_MINLOC; }
+	YY_BREAK
+case 137:
+YY_RULE_SETUP
+#line 242 "fortran.lex"
+{ return TOK_MAXLOC; }
+	YY_BREAK
+case 138:
+YY_RULE_SETUP
+#line 243 "fortran.lex"
+{ return TOK_MINVAL; }
+	YY_BREAK
+case 139:
+YY_RULE_SETUP
+#line 244 "fortran.lex"
+{ return TOK_BACKSPACE; }
+	YY_BREAK
+case 140:
+YY_RULE_SETUP
+#line 245 "fortran.lex"
+{ return TOK_FOURDOTS;  }
+	YY_BREAK
+case 141:
+YY_RULE_SETUP
+#line 246 "fortran.lex"
+{ return TOK_LEFTAB; }
+	YY_BREAK
+case 142:
+YY_RULE_SETUP
+#line 247 "fortran.lex"
+{ return TOK_RIGHTAB; }
+	YY_BREAK
+case 143:
+/* rule 143 can match eol */
+YY_RULE_SETUP
+#line 248 "fortran.lex"
+{
+                              return TOK_FORMAT; }
+	YY_BREAK
+case 144:
+YY_RULE_SETUP
+#line 250 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_SLASH; }
+	YY_BREAK
+case 145:
+YY_RULE_SETUP
+#line 251 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
+	YY_BREAK
+case 146:
+/* rule 146 can match eol */
+YY_RULE_SETUP
+#line 252 "fortran.lex"
+{
+                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+	YY_BREAK
+case 147:
+/* rule 147 can match eol */
+YY_RULE_SETUP
+#line 254 "fortran.lex"
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+	YY_BREAK
+case 148:
+/* rule 148 can match eol */
+YY_RULE_SETUP
+#line 255 "fortran.lex"
+{ strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+	YY_BREAK
+case 149:
+YY_RULE_SETUP
+#line 256 "fortran.lex"
+{ BEGIN(donottreat); }
+	YY_BREAK
+case 150:
+/* rule 150 can match eol */
+YY_RULE_SETUP
+#line 257 "fortran.lex"
+{ out_of_donottreat(); return '\n'; }
+	YY_BREAK
+case 151:
+YY_RULE_SETUP
+#line 258 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_NAME; }
+	YY_BREAK
+case 152:
+/* rule 152 can match eol */
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
+YY_RULE_SETUP
+#line 259 "fortran.lex"
+{  // REAL1
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 153:
+YY_RULE_SETUP
+#line 261 "fortran.lex"
+{  // REAL2
+                              strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
+	YY_BREAK
+case 154:
+YY_RULE_SETUP
+#line 263 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+	YY_BREAK
+case 155:
+YY_RULE_SETUP
+#line 264 "fortran.lex"
+{}
+	YY_BREAK
+case 156:
+YY_RULE_SETUP
+#line 265 "fortran.lex"
+{}
+	YY_BREAK
+case 157:
+YY_RULE_SETUP
+#line 266 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 158:
+YY_RULE_SETUP
+#line 267 "fortran.lex"
+{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+	YY_BREAK
+case 159:
+YY_RULE_SETUP
+#line 268 "fortran.lex"
+{ return TOK_SEMICOLON; }
+	YY_BREAK
+case 160:
+YY_RULE_SETUP
+#line 269 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 161:
+YY_RULE_SETUP
+#line 270 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 162:
+YY_RULE_SETUP
+#line 271 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 163:
+YY_RULE_SETUP
+#line 272 "fortran.lex"
+{ return (int) *fortran_text; }
+	YY_BREAK
+case 164:
+/* rule 164 can match eol */
+YY_RULE_SETUP
+#line 273 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; return '\n'; }
+	YY_BREAK
+case 165:
+*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */
+(yy_c_buf_p) = yy_cp -= 1;
+YY_DO_BEFORE_ACTION; /* set up fortran_text again */
+YY_RULE_SETUP
+#line 274 "fortran.lex"
+{}
+	YY_BREAK
+case 166:
+YY_RULE_SETUP
+#line 275 "fortran.lex"
+{}
+	YY_BREAK
+case 167:
+YY_RULE_SETUP
+#line 276 "fortran.lex"
+{ if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+	YY_BREAK
+case 168:
+/* rule 168 can match eol */
+YY_RULE_SETUP
+#line 277 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; newlinef90=1; }
+	YY_BREAK
+case 169:
+/* rule 169 can match eol */
+YY_RULE_SETUP
+#line 278 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 170:
+/* rule 170 can match eol */
+YY_RULE_SETUP
+#line 280 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+	YY_BREAK
+case 171:
+/* rule 171 can match eol */
+YY_RULE_SETUP
+#line 281 "fortran.lex"
+{ out_of_donottreat(); return '\n'; }
+	YY_BREAK
+case 172:
+/* rule 172 can match eol */
+YY_RULE_SETUP
+#line 282 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 173:
+/* rule 173 can match eol */
+YY_RULE_SETUP
+#line 283 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 174:
+/* rule 174 can match eol */
+YY_RULE_SETUP
+#line 284 "fortran.lex"
+{ INCREMENT_LINE_NUM() ; }
+	YY_BREAK
+case 175:
+YY_RULE_SETUP
+#line 285 "fortran.lex"
+{}
+	YY_BREAK
+case 176:
+YY_RULE_SETUP
+#line 286 "fortran.lex"
+ECHO;
+	YY_BREAK
+#line 3015 "fortran.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(parameter):
+case YY_STATE_EOF(character):
+case YY_STATE_EOF(donottreat):
+case YY_STATE_EOF(fortran77style):
+case YY_STATE_EOF(fortran90style):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = (yy_hold_char);
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed fortran_in at a new source and called
+			 * fortran_lex().  If so, then we have to assure
+			 * consistency between YY_CURRENT_BUFFER and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortran_in;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state(  );
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++(yy_c_buf_p);
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = (yy_c_buf_p);
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer(  ) )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				(yy_did_buffer_switch_on_eof) = 0;
+
+				if ( fortran_wrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * fortran_text, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				(yy_c_buf_p) =
+					(yytext_ptr) + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				(yy_c_buf_p) =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+} /* end of fortran_lex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+	register char *source = (yytext_ptr);
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+	else
+		{
+			yy_size_t num_to_read =
+			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					fortran_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+			(yy_n_chars), num_to_read );
+
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	if ( (yy_n_chars) == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			fortran_restart(fortran_in  );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+		/* Extend the array by 50%, plus the number we really need. */
+		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortran_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+	}
+
+	(yy_n_chars) += number_to_move;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+	return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+    static yy_state_type yy_get_previous_state (void)
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+    
+	yy_current_state = (yy_start);
+	yy_current_state += YY_AT_BOL();
+
+	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 1132 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
+{
+	register int yy_is_jam;
+    	register char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 1132 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 1131);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up fortran_text */
+	*yy_cp = (yy_hold_char);
+
+	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+		register char *source =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+	(yytext_ptr) = yy_bp;
+	(yy_hold_char) = *yy_cp;
+	(yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+    static int yyinput (void)
+#else
+    static int input  (void)
+#endif
+
+{
+	int c;
+    
+	*(yy_c_buf_p) = (yy_hold_char);
+
+	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			/* This was really a NUL. */
+			*(yy_c_buf_p) = '\0';
+
+		else
+			{ /* need more input */
+			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			++(yy_c_buf_p);
+
+			switch ( yy_get_next_buffer(  ) )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					fortran_restart(fortran_in );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( fortran_wrap( ) )
+						return 0;
+
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					(yy_c_buf_p) = (yytext_ptr) + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
+	*(yy_c_buf_p) = '\0';	/* preserve fortran_text */
+	(yy_hold_char) = *++(yy_c_buf_p);
+
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n');
+
+	return c;
+}
+#endif	/* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ * 
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+    void fortran_restart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        fortran_ensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            fortran__create_buffer(fortran_in,YY_BUF_SIZE );
+	}
+
+	fortran__init_buffer(YY_CURRENT_BUFFER,input_file );
+	fortran__load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void fortran__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		fortran_pop_buffer_state();
+	 *		fortran_push_buffer_state(new_buffer);
+     */
+	fortran_ensure_buffer_stack ();
+	if ( YY_CURRENT_BUFFER == new_buffer )
+		return;
+
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+	fortran__load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (fortran_wrap()) processing, but the only time this flag
+	 * is looked at is after fortran_wrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void fortran__load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	fortran_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ * 
+ * @return the allocated buffer state.
+ */
+    YY_BUFFER_STATE fortran__create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) fortran_alloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	fortran__init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with fortran__create_buffer()
+ * 
+ */
+    void fortran__delete_buffer (YY_BUFFER_STATE  b )
+{
+    
+	if ( ! b )
+		return;
+
+	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		fortran_free((void *) b->yy_ch_buf  );
+
+	fortran_free((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a fortran_restart() or at EOF.
+ */
+    static void fortran__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	fortran__flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then fortran__init_buffer was _probably_
+     * called from fortran_restart() or through yy_get_next_buffer.
+     * In that case, we don't want to reset the lineno or column.
+     */
+    if (b != YY_CURRENT_BUFFER){
+        b->yy_bs_lineno = 1;
+        b->yy_bs_column = 0;
+    }
+
+        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+    
+	errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ * 
+ */
+    void fortran__flush_buffer (YY_BUFFER_STATE  b )
+{
+    	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == YY_CURRENT_BUFFER )
+		fortran__load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ *  the current state. This function will allocate the stack
+ *  if necessary.
+ *  @param new_buffer The new state.
+ *  
+ */
+void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	fortran_ensure_buffer_stack();
+
+	/* This block is copied from fortran__switch_to_buffer. */
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	/* Only push if top exists. Otherwise, replace top. */
+	if (YY_CURRENT_BUFFER)
+		(yy_buffer_stack_top)++;
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+	/* copied from fortran__switch_to_buffer. */
+	fortran__load_buffer_state( );
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ *  The next element becomes the new top.
+ *  
+ */
+void fortran_pop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	fortran__delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		fortran__load_buffer_state( );
+		(yy_did_buffer_switch_on_eof) = 1;
+	}
+}
+
+/* Allocates the stack if it does not exist.
+ *  Guarantees space for at least one push.
+ */
+static void fortran_ensure_buffer_stack (void)
+{
+	yy_size_t num_to_alloc;
+    
+	if (!(yy_buffer_stack)) {
+
+		/* First allocation is just for 2 elements, since we don't know if this
+		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
+		 * immediate realloc on the next call.
+         */
+		num_to_alloc = 1;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_alloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
+								  
+		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+				
+		(yy_buffer_stack_max) = num_to_alloc;
+		(yy_buffer_stack_top) = 0;
+		return;
+	}
+
+	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+		/* Increase the buffer to prepare for a possible push. */
+		int grow_size = 8 /* arbitrary grow size */;
+
+		num_to_alloc = (yy_buffer_stack_max) + grow_size;
+		(yy_buffer_stack) = (struct yy_buffer_state**)fortran_realloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" );
+
+		/* zero only the new slots.*/
+		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+		(yy_buffer_stack_max) = num_to_alloc;
+	}
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ * 
+ * @return the newly allocated buffer state object. 
+ */
+YY_BUFFER_STATE fortran__scan_buffer  (char * base, yy_size_t  size )
+{
+	YY_BUFFER_STATE b;
+    
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	fortran__switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to fortran_lex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ * 
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ *       fortran__scan_bytes() instead.
+ */
+YY_BUFFER_STATE fortran__scan_string (yyconst char * yystr )
+{
+    
+	return fortran__scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to fortran_lex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * 
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE fortran__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n, i;
+    
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = _yybytes_len + 2;
+	buf = (char *) fortran_alloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_bytes()" );
+
+	for ( i = 0; i < _yybytes_len; ++i )
+		buf[i] = yybytes[i];
+
+	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = fortran__scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in fortran__scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+    	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up fortran_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		fortran_text[fortran_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = fortran_text + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		fortran_leng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int fortran_get_lineno  (void)
+{
+        
+    return fortran_lineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *fortran_get_in  (void)
+{
+        return fortran_in;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *fortran_get_out  (void)
+{
+        return fortran_out;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t fortran_get_leng  (void)
+{
+        return fortran_leng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *fortran_get_text  (void)
+{
+        return fortran_text;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void fortran_set_lineno (int  line_number )
+{
+    
+    fortran_lineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see fortran__switch_to_buffer
+ */
+void fortran_set_in (FILE *  in_str )
+{
+        fortran_in = in_str ;
+}
+
+void fortran_set_out (FILE *  out_str )
+{
+        fortran_out = out_str ;
+}
+
+int fortran_get_debug  (void)
+{
+        return fortran__flex_debug;
+}
+
+void fortran_set_debug (int  bdebug )
+{
+        fortran__flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from fortran_lex_destroy(), so don't allocate here.
+     */
+
+    (yy_buffer_stack) = 0;
+    (yy_buffer_stack_top) = 0;
+    (yy_buffer_stack_max) = 0;
+    (yy_c_buf_p) = (char *) 0;
+    (yy_init) = 0;
+    (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+    fortran_in = stdin;
+    fortran_out = stdout;
+#else
+    fortran_in = (FILE *) 0;
+    fortran_out = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * fortran_lex_init()
+     */
+    return 0;
+}
+
+/* fortran_lex_destroy is for both reentrant and non-reentrant scanners. */
+int fortran_lex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		fortran__delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		fortran_pop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	fortran_free((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * fortran_lex() is called, initialization will occur. */
+    yy_init_globals( );
+
+    return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+}
+#endif
+
+void *fortran_alloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *fortran_realloc  (void * ptr, yy_size_t  size )
+{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+}
+
+void fortran_free (void * ptr )
+{
+	free( (char *) ptr );	/* see fortran_realloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 286 "fortran.lex"
+
+
+
+void out_of_donottreat ( void )
+{
+    BEGIN(INITIAL);
+    if (infixed) BEGIN(fortran77style) ;
+    if (infree)  BEGIN(fortran90style) ;
+    INCREMENT_LINE_NUM() ;
+}
+
Index: vendors/AGRIF/LIB/main.c
===================================================================
--- vendors/AGRIF/LIB/main.c	(revision 9621)
+++ vendors/AGRIF/LIB/main.c	(revision 9621)
@@ -0,0 +1,3930 @@
+/* A Bison parser, made by GNU Bison 2.3.  */
+
+/* Skeleton implementation for Bison's Yacc-like parsers in C
+
+   Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2, or (at your option)
+   any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor,
+   Boston, MA 02110-1301, USA.  */
+
+/* As a special exception, you may create a larger work that contains
+   part or all of the Bison parser skeleton and distribute that work
+   under terms of your choice, so long as that work isn't itself a
+   parser generator using the skeleton or a modified version thereof
+   as a parser skeleton.  Alternatively, if you modify or redistribute
+   the parser skeleton itself, you may (at your option) remove this
+   special exception, which will cause the skeleton and the resulting
+   Bison output files to be licensed under the GNU General Public
+   License without this special exception.
+
+   This special exception was added by the Free Software Foundation in
+   version 2.2 of Bison.  */
+
+/* C LALR(1) parser skeleton written by Richard Stallman, by
+   simplifying the original so-called "semantic" parser.  */
+
+/* All symbols defined below should begin with yy or YY, to avoid
+   infringing on user name space.  This should be done even for local
+   variables, as they might otherwise be expanded by user macros.
+   There are some unavoidable exceptions within include files to
+   define necessary library symbols; they are noted "INFRINGES ON
+   USER NAME SPACE" below.  */
+
+/* Identify Bison output.  */
+#define YYBISON 1
+
+/* Bison version.  */
+#define YYBISON_VERSION "2.3"
+
+/* Skeleton name.  */
+#define YYSKELETON_NAME "yacc.c"
+
+/* Pure parsers.  */
+#define YYPURE 0
+
+/* Using locations.  */
+#define YYLSP_NEEDED 0
+
+/* Substitute the variable and function names.  */
+#define yyparse convert_parse
+#define yylex   convert_lex
+#define yyerror convert_error
+#define yylval  convert_lval
+#define yychar  convert_char
+#define yydebug convert_debug
+#define yynerrs convert_nerrs
+
+
+/* Tokens.  */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+   /* Put the tokens into the symbol table, so that GDB and other debuggers
+      know about them.  */
+   enum yytokentype {
+     TOK_SEP = 258,
+     TOK_KIND = 259,
+     TOK_EQUAL = 260,
+     TOK_USE = 261,
+     TOK_MODULEMAIN = 262,
+     TOK_NOTGRIDDEP = 263,
+     TOK_USEITEM = 264,
+     TOK_NAME = 265,
+     TOK_CSTINT = 266,
+     TOK_PROBTYPE = 267
+   };
+#endif
+/* Tokens.  */
+#define TOK_SEP 258
+#define TOK_KIND 259
+#define TOK_EQUAL 260
+#define TOK_USE 261
+#define TOK_MODULEMAIN 262
+#define TOK_NOTGRIDDEP 263
+#define TOK_USEITEM 264
+#define TOK_NAME 265
+#define TOK_CSTINT 266
+#define TOK_PROBTYPE 267
+
+
+
+
+/* Copy the first part of user declarations.  */
+#line 35 "convert.y"
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+int line_num=1;
+extern FILE * convert_in;
+
+int convert_error(const char *s)
+{
+    printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file);
+    exit(0);
+}
+
+
+
+/* Enabling traces.  */
+#ifndef YYDEBUG
+# define YYDEBUG 1
+#endif
+
+/* Enabling verbose error messages.  */
+#ifdef YYERROR_VERBOSE
+# undef YYERROR_VERBOSE
+# define YYERROR_VERBOSE 1
+#else
+# define YYERROR_VERBOSE 0
+#endif
+
+/* Enabling the token table.  */
+#ifndef YYTOKEN_TABLE
+# define YYTOKEN_TABLE 0
+#endif
+
+#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
+typedef union YYSTYPE
+#line 52 "convert.y"
+{
+    char na[LONG_M];
+}
+/* Line 193 of yacc.c.  */
+#line 149 "convert.tab.c"
+	YYSTYPE;
+# define yystype YYSTYPE /* obsolescent; will be withdrawn */
+# define YYSTYPE_IS_DECLARED 1
+# define YYSTYPE_IS_TRIVIAL 1
+#endif
+
+
+
+/* Copy the second part of user declarations.  */
+
+
+/* Line 216 of yacc.c.  */
+#line 162 "convert.tab.c"
+
+#ifdef short
+# undef short
+#endif
+
+#ifdef YYTYPE_UINT8
+typedef YYTYPE_UINT8 yytype_uint8;
+#else
+typedef unsigned char yytype_uint8;
+#endif
+
+#ifdef YYTYPE_INT8
+typedef YYTYPE_INT8 yytype_int8;
+#elif (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+typedef signed char yytype_int8;
+#else
+typedef short int yytype_int8;
+#endif
+
+#ifdef YYTYPE_UINT16
+typedef YYTYPE_UINT16 yytype_uint16;
+#else
+typedef unsigned short int yytype_uint16;
+#endif
+
+#ifdef YYTYPE_INT16
+typedef YYTYPE_INT16 yytype_int16;
+#else
+typedef short int yytype_int16;
+#endif
+
+#ifndef YYSIZE_T
+# ifdef __SIZE_TYPE__
+#  define YYSIZE_T __SIZE_TYPE__
+# elif defined size_t
+#  define YYSIZE_T size_t
+# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#  include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYSIZE_T size_t
+# else
+#  define YYSIZE_T unsigned int
+# endif
+#endif
+
+#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
+
+#ifndef YY_
+# if defined YYENABLE_NLS && YYENABLE_NLS
+#  if ENABLE_NLS
+#   include <libintl.h> /* INFRINGES ON USER NAME SPACE */
+#   define YY_(msgid) dgettext ("bison-runtime", msgid)
+#  endif
+# endif
+# ifndef YY_
+#  define YY_(msgid) msgid
+# endif
+#endif
+
+/* Suppress unused-variable warnings by "using" E.  */
+#if ! defined lint || defined __GNUC__
+# define YYUSE(e) ((void) (e))
+#else
+# define YYUSE(e) /* empty */
+#endif
+
+/* Identity function, used to suppress warnings about constant conditions.  */
+#ifndef lint
+# define YYID(n) (n)
+#else
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static int
+YYID (int i)
+#else
+static int
+YYID (i)
+    int i;
+#endif
+{
+  return i;
+}
+#endif
+
+#if ! defined yyoverflow || YYERROR_VERBOSE
+
+/* The parser invokes alloca or malloc; define the necessary symbols.  */
+
+# ifdef YYSTACK_USE_ALLOCA
+#  if YYSTACK_USE_ALLOCA
+#   ifdef __GNUC__
+#    define YYSTACK_ALLOC __builtin_alloca
+#   elif defined __BUILTIN_VA_ARG_INCR
+#    include <alloca.h> /* INFRINGES ON USER NAME SPACE */
+#   elif defined _AIX
+#    define YYSTACK_ALLOC __alloca
+#   elif defined _MSC_VER
+#    include <malloc.h> /* INFRINGES ON USER NAME SPACE */
+#    define alloca _alloca
+#   else
+#    define YYSTACK_ALLOC alloca
+#    if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+#     include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#     ifndef _STDLIB_H
+#      define _STDLIB_H 1
+#     endif
+#    endif
+#   endif
+#  endif
+# endif
+
+# ifdef YYSTACK_ALLOC
+   /* Pacify GCC's `empty if-body' warning.  */
+#  define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+    /* The OS might guarantee only one guard page at the bottom of the stack,
+       and a page size can be as small as 4096 bytes.  So we cannot safely
+       invoke alloca (N) if N exceeds 4096.  Use a slightly smaller number
+       to allow for a few compiler-allocated temporary stack slots.  */
+#   define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */
+#  endif
+# else
+#  define YYSTACK_ALLOC YYMALLOC
+#  define YYSTACK_FREE YYFREE
+#  ifndef YYSTACK_ALLOC_MAXIMUM
+#   define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
+#  endif
+#  if (defined __cplusplus && ! defined _STDLIB_H \
+       && ! ((defined YYMALLOC || defined malloc) \
+	     && (defined YYFREE || defined free)))
+#   include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
+#   ifndef _STDLIB_H
+#    define _STDLIB_H 1
+#   endif
+#  endif
+#  ifndef YYMALLOC
+#   define YYMALLOC malloc
+#   if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+#  ifndef YYFREE
+#   define YYFREE free
+#   if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+void free (void *); /* INFRINGES ON USER NAME SPACE */
+#   endif
+#  endif
+# endif
+#endif /* ! defined yyoverflow || YYERROR_VERBOSE */
+
+
+#if (! defined yyoverflow \
+     && (! defined __cplusplus \
+	 || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+
+/* A type that is properly aligned for any stack member.  */
+union yyalloc
+{
+  yytype_int16 yyss;
+  YYSTYPE yyvs;
+  };
+
+/* The size of the maximum gap between one aligned stack and the next.  */
+# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1)
+
+/* The size of an array large to enough to hold all stacks, each with
+   N elements.  */
+# define YYSTACK_BYTES(N) \
+     ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \
+      + YYSTACK_GAP_MAXIMUM)
+
+/* Copy COUNT objects from FROM to TO.  The source and destination do
+   not overlap.  */
+# ifndef YYCOPY
+#  if defined __GNUC__ && 1 < __GNUC__
+#   define YYCOPY(To, From, Count) \
+      __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
+#  else
+#   define YYCOPY(To, From, Count)		\
+      do					\
+	{					\
+	  YYSIZE_T yyi;				\
+	  for (yyi = 0; yyi < (Count); yyi++)	\
+	    (To)[yyi] = (From)[yyi];		\
+	}					\
+      while (YYID (0))
+#  endif
+# endif
+
+/* Relocate STACK from its old location to the new one.  The
+   local variables YYSIZE and YYSTACKSIZE give the old and new number of
+   elements in the stack, and YYPTR gives the new location of the
+   stack.  Advance YYPTR to a properly aligned location for the next
+   stack.  */
+# define YYSTACK_RELOCATE(Stack)					\
+    do									\
+      {									\
+	YYSIZE_T yynewbytes;						\
+	YYCOPY (&yyptr->Stack, Stack, yysize);				\
+	Stack = &yyptr->Stack;						\
+	yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+	yyptr += yynewbytes / sizeof (*yyptr);				\
+      }									\
+    while (YYID (0))
+
+#endif
+
+/* YYFINAL -- State number of the termination state.  */
+#define YYFINAL  2
+/* YYLAST -- Last index in YYTABLE.  */
+#define YYLAST   29
+
+/* YYNTOKENS -- Number of terminals.  */
+#define YYNTOKENS  16
+/* YYNNTS -- Number of nonterminals.  */
+#define YYNNTS  3
+/* YYNRULES -- Number of rules.  */
+#define YYNRULES  11
+/* YYNRULES -- Number of states.  */
+#define YYNSTATES  29
+
+/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX.  */
+#define YYUNDEFTOK  2
+#define YYMAXUTOK   267
+
+#define YYTRANSLATE(YYX)						\
+  ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+
+/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX.  */
+static const yytype_uint8 yytranslate[] =
+{
+       0,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+      15,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,    13,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,    14,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     2,     2,     2,     2,     2,     1,     2,     3,     4,
+       5,     6,     7,     8,     9,    10,    11,    12
+};
+
+#if YYDEBUG
+/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
+   YYRHS.  */
+static const yytype_uint8 yyprhs[] =
+{
+       0,     0,     3,     4,     7,     9,    13,    19,    27,    31,
+      37,    42
+};
+
+/* YYRHS -- A `-1'-separated list of the rules' RHS.  */
+static const yytype_int8 yyrhs[] =
+{
+      17,     0,    -1,    -1,    17,    18,    -1,    15,    -1,    12,
+      10,    14,    -1,    12,    10,    13,    10,    14,    -1,    12,
+      10,    13,    10,    13,    10,    14,    -1,     7,    10,    14,
+      -1,     4,    10,     5,    11,    14,    -1,     8,     3,    10,
+      14,    -1,     6,     9,    14,    -1
+};
+
+/* YYRLINE[YYN] -- source line where rule number YYN was defined.  */
+static const yytype_uint8 yyrline[] =
+{
+       0,    71,    71,    72,    75,    76,    77,    78,    79,    84,
+     100,   104
+};
+#endif
+
+#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
+   First, the terminals, then, starting at YYNTOKENS, nonterminals.  */
+static const char *const yytname[] =
+{
+  "$end", "error", "$undefined", "TOK_SEP", "TOK_KIND", "TOK_EQUAL",
+  "TOK_USE", "TOK_MODULEMAIN", "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME",
+  "TOK_CSTINT", "TOK_PROBTYPE", "','", "';'", "'\\n'", "$accept", "input",
+  "line", 0
+};
+#endif
+
+# ifdef YYPRINT
+/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
+   token YYLEX-NUM.  */
+static const yytype_uint16 yytoknum[] =
+{
+       0,   256,   257,   258,   259,   260,   261,   262,   263,   264,
+     265,   266,   267,    44,    59,    10
+};
+# endif
+
+/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
+static const yytype_uint8 yyr1[] =
+{
+       0,    16,    17,    17,    18,    18,    18,    18,    18,    18,
+      18,    18
+};
+
+/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN.  */
+static const yytype_uint8 yyr2[] =
+{
+       0,     2,     0,     2,     1,     3,     5,     7,     3,     5,
+       4,     3
+};
+
+/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
+   STATE-NUM when YYTABLE doesn't specify something else to do.  Zero
+   means the default is an error.  */
+static const yytype_uint8 yydefact[] =
+{
+       2,     0,     1,     0,     0,     0,     0,     0,     4,     3,
+       0,     0,     0,     0,     0,     0,    11,     8,     0,     0,
+       5,     0,    10,     0,     9,     0,     6,     0,     7
+};
+
+/* YYDEFGOTO[NTERM-NUM].  */
+static const yytype_int8 yydefgoto[] =
+{
+      -1,     1,     9
+};
+
+/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+   STATE-NUM.  */
+#define YYPACT_NINF -13
+static const yytype_int8 yypact[] =
+{
+     -13,     0,   -13,    -7,     2,    -5,    10,     4,   -13,   -13,
+      11,     3,     5,     8,   -12,     9,   -13,   -13,     7,    12,
+     -13,    13,   -13,    -4,   -13,    14,   -13,    15,   -13
+};
+
+/* YYPGOTO[NTERM-NUM].  */
+static const yytype_int8 yypgoto[] =
+{
+     -13,   -13,   -13
+};
+
+/* YYTABLE[YYPACT[STATE-NUM]].  What to do in state STATE-NUM.  If
+   positive, shift that token.  If negative, reduce the rule which
+   number is the opposite.  If zero, do what YYDEFACT says.
+   If YYTABLE_NINF, syntax error.  */
+#define YYTABLE_NINF -1
+static const yytype_uint8 yytable[] =
+{
+       2,    19,    20,    10,     3,    12,     4,     5,     6,    25,
+      26,    11,     7,    13,    14,     8,    15,    16,    18,    17,
+      21,    22,    23,     0,    27,     0,     0,    24,     0,    28
+};
+
+static const yytype_int8 yycheck[] =
+{
+       0,    13,    14,    10,     4,    10,     6,     7,     8,    13,
+      14,     9,    12,     3,    10,    15,     5,    14,    10,    14,
+      11,    14,    10,    -1,    10,    -1,    -1,    14,    -1,    14
+};
+
+/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+   symbol of state STATE-NUM.  */
+static const yytype_uint8 yystos[] =
+{
+       0,    17,     0,     4,     6,     7,     8,    12,    15,    18,
+      10,     9,    10,     3,    10,     5,    14,    14,    10,    13,
+      14,    11,    14,    10,    14,    13,    14,    10,    14
+};
+
+#define yyerrok		(yyerrstatus = 0)
+#define yyclearin	(yychar = YYEMPTY)
+#define YYEMPTY		(-2)
+#define YYEOF		0
+
+#define YYACCEPT	goto yyacceptlab
+#define YYABORT		goto yyabortlab
+#define YYERROR		goto yyerrorlab
+
+
+/* Like YYERROR except do call yyerror.  This remains here temporarily
+   to ease the transition to the new meaning of YYERROR, for GCC.
+   Once GCC version 2 has supplanted version 1, this can go.  */
+
+#define YYFAIL		goto yyerrlab
+
+#define YYRECOVERING()  (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value)					\
+do								\
+  if (yychar == YYEMPTY && yylen == 1)				\
+    {								\
+      yychar = (Token);						\
+      yylval = (Value);						\
+      yytoken = YYTRANSLATE (yychar);				\
+      YYPOPSTACK (1);						\
+      goto yybackup;						\
+    }								\
+  else								\
+    {								\
+      yyerror (YY_("syntax error: cannot back up")); \
+      YYERROR;							\
+    }								\
+while (YYID (0))
+
+
+#define YYTERROR	1
+#define YYERRCODE	256
+
+
+/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
+   If N is 0, then set CURRENT to the empty location which ends
+   the previous symbol: RHS[0] (always defined).  */
+
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+#ifndef YYLLOC_DEFAULT
+# define YYLLOC_DEFAULT(Current, Rhs, N)				\
+    do									\
+      if (YYID (N))                                                    \
+	{								\
+	  (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
+	  (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
+	  (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
+	  (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
+	}								\
+      else								\
+	{								\
+	  (Current).first_line   = (Current).last_line   =		\
+	    YYRHSLOC (Rhs, 0).last_line;				\
+	  (Current).first_column = (Current).last_column =		\
+	    YYRHSLOC (Rhs, 0).last_column;				\
+	}								\
+    while (YYID (0))
+#endif
+
+
+/* YY_LOCATION_PRINT -- Print the location on the stream.
+   This macro was not mandated originally: define only if we know
+   we won't break user code: when these are the locations we know.  */
+
+#ifndef YY_LOCATION_PRINT
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+#  define YY_LOCATION_PRINT(File, Loc)			\
+     fprintf (File, "%d.%d-%d.%d",			\
+	      (Loc).first_line, (Loc).first_column,	\
+	      (Loc).last_line,  (Loc).last_column)
+# else
+#  define YY_LOCATION_PRINT(File, Loc) ((void) 0)
+# endif
+#endif
+
+
+/* YYLEX -- calling `yylex' with the right arguments.  */
+
+#ifdef YYLEX_PARAM
+# define YYLEX yylex (YYLEX_PARAM)
+#else
+# define YYLEX yylex ()
+#endif
+
+/* Enable debugging if requested.  */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+#  include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+#  define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args)			\
+do {						\
+  if (yydebug)					\
+    YYFPRINTF Args;				\
+} while (YYID (0))
+
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)			  \
+do {									  \
+  if (yydebug)								  \
+    {									  \
+      YYFPRINTF (stderr, "%s ", Title);					  \
+      yy_symbol_print (stderr,						  \
+		  Type, Value); \
+      YYFPRINTF (stderr, "\n");						  \
+    }									  \
+} while (YYID (0))
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_value_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (!yyvaluep)
+    return;
+# ifdef YYPRINT
+  if (yytype < YYNTOKENS)
+    YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+  YYUSE (yyoutput);
+# endif
+  switch (yytype)
+    {
+      default:
+	break;
+    }
+}
+
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT.  |
+`--------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep)
+#else
+static void
+yy_symbol_print (yyoutput, yytype, yyvaluep)
+    FILE *yyoutput;
+    int yytype;
+    YYSTYPE const * const yyvaluep;
+#endif
+{
+  if (yytype < YYNTOKENS)
+    YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+  else
+    YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+  yy_symbol_value_print (yyoutput, yytype, yyvaluep);
+  YYFPRINTF (yyoutput, ")");
+}
+
+/*------------------------------------------------------------------.
+| yy_stack_print -- Print the state stack from its BOTTOM up to its |
+| TOP (included).                                                   |
+`------------------------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
+#else
+static void
+yy_stack_print (bottom, top)
+    yytype_int16 *bottom;
+    yytype_int16 *top;
+#endif
+{
+  YYFPRINTF (stderr, "Stack now");
+  for (; bottom <= top; ++bottom)
+    YYFPRINTF (stderr, " %d", *bottom);
+  YYFPRINTF (stderr, "\n");
+}
+
+# define YY_STACK_PRINT(Bottom, Top)				\
+do {								\
+  if (yydebug)							\
+    yy_stack_print ((Bottom), (Top));				\
+} while (YYID (0))
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced.  |
+`------------------------------------------------*/
+
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yy_reduce_print (YYSTYPE *yyvsp, int yyrule)
+#else
+static void
+yy_reduce_print (yyvsp, yyrule)
+    YYSTYPE *yyvsp;
+    int yyrule;
+#endif
+{
+  int yynrhs = yyr2[yyrule];
+  int yyi;
+  unsigned long int yylno = yyrline[yyrule];
+  YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
+	     yyrule - 1, yylno);
+  /* The symbols being reduced.  */
+  for (yyi = 0; yyi < yynrhs; yyi++)
+    {
+      fprintf (stderr, "   $%d = ", yyi + 1);
+      yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
+		       &(yyvsp[(yyi + 1) - (yynrhs)])
+		       		       );
+      fprintf (stderr, "\n");
+    }
+}
+
+# define YY_REDUCE_PRINT(Rule)		\
+do {					\
+  if (yydebug)				\
+    yy_reduce_print (yyvsp, Rule); \
+} while (YYID (0))
+
+/* Nonzero means print parse trace.  It is left uninitialized so that
+   multiple parsers can coexist.  */
+int yydebug;
+#else /* !YYDEBUG */
+# define YYDPRINTF(Args)
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location)
+# define YY_STACK_PRINT(Bottom, Top)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !YYDEBUG */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#ifndef	YYINITDEPTH
+# define YYINITDEPTH 200
+#endif
+
+/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only
+   if the built-in stack extension method is used).
+
+   Do not make this value too large; the results are undefined if
+   YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH)
+   evaluated with infinite-precision integer arithmetic.  */
+
+#ifndef YYMAXDEPTH
+# define YYMAXDEPTH 10000
+#endif
+
+
+
+
+#if YYERROR_VERBOSE
+
+# ifndef yystrlen
+#  if defined __GLIBC__ && defined _STRING_H
+#   define yystrlen strlen
+#  else
+/* Return the length of YYSTR.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static YYSIZE_T
+yystrlen (const char *yystr)
+#else
+static YYSIZE_T
+yystrlen (yystr)
+    const char *yystr;
+#endif
+{
+  YYSIZE_T yylen;
+  for (yylen = 0; yystr[yylen]; yylen++)
+    continue;
+  return yylen;
+}
+#  endif
+# endif
+
+# ifndef yystpcpy
+#  if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE
+#   define yystpcpy stpcpy
+#  else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+   YYDEST.  */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static char *
+yystpcpy (char *yydest, const char *yysrc)
+#else
+static char *
+yystpcpy (yydest, yysrc)
+    char *yydest;
+    const char *yysrc;
+#endif
+{
+  char *yyd = yydest;
+  const char *yys = yysrc;
+
+  while ((*yyd++ = *yys++) != '\0')
+    continue;
+
+  return yyd - 1;
+}
+#  endif
+# endif
+
+# ifndef yytnamerr
+/* Copy to YYRES the contents of YYSTR after stripping away unnecessary
+   quotes and backslashes, so that it's suitable for yyerror.  The
+   heuristic is that double-quoting is unnecessary unless the string
+   contains an apostrophe, a comma, or backslash (other than
+   backslash-backslash).  YYSTR is taken from yytname.  If YYRES is
+   null, do not copy; instead, return the length of what the result
+   would have been.  */
+static YYSIZE_T
+yytnamerr (char *yyres, const char *yystr)
+{
+  if (*yystr == '"')
+    {
+      YYSIZE_T yyn = 0;
+      char const *yyp = yystr;
+
+      for (;;)
+	switch (*++yyp)
+	  {
+	  case '\'':
+	  case ',':
+	    goto do_not_strip_quotes;
+
+	  case '\\':
+	    if (*++yyp != '\\')
+	      goto do_not_strip_quotes;
+	    /* Fall through.  */
+	  default:
+	    if (yyres)
+	      yyres[yyn] = *yyp;
+	    yyn++;
+	    break;
+
+	  case '"':
+	    if (yyres)
+	      yyres[yyn] = '\0';
+	    return yyn;
+	  }
+    do_not_strip_quotes: ;
+    }
+
+  if (! yyres)
+    return yystrlen (yystr);
+
+  return yystpcpy (yyres, yystr) - yyres;
+}
+# endif
+
+/* Copy into YYRESULT an error message about the unexpected token
+   YYCHAR while in state YYSTATE.  Return the number of bytes copied,
+   including the terminating null byte.  If YYRESULT is null, do not
+   copy anything; just return the number of bytes that would be
+   copied.  As a special case, return 0 if an ordinary "syntax error"
+   message will do.  Return YYSIZE_MAXIMUM if overflow occurs during
+   size calculation.  */
+static YYSIZE_T
+yysyntax_error (char *yyresult, int yystate, int yychar)
+{
+  int yyn = yypact[yystate];
+
+  if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
+    return 0;
+  else
+    {
+      int yytype = YYTRANSLATE (yychar);
+      YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
+      YYSIZE_T yysize = yysize0;
+      YYSIZE_T yysize1;
+      int yysize_overflow = 0;
+      enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+      char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+      int yyx;
+
+# if 0
+      /* This is so xgettext sees the translatable formats that are
+	 constructed on the fly.  */
+      YY_("syntax error, unexpected %s");
+      YY_("syntax error, unexpected %s, expecting %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s");
+      YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
+# endif
+      char *yyfmt;
+      char const *yyf;
+      static char const yyunexpected[] = "syntax error, unexpected %s";
+      static char const yyexpecting[] = ", expecting %s";
+      static char const yyor[] = " or %s";
+      char yyformat[sizeof yyunexpected
+		    + sizeof yyexpecting - 1
+		    + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
+		       * (sizeof yyor - 1))];
+      char const *yyprefix = yyexpecting;
+
+      /* Start YYX at -YYN if negative to avoid negative indexes in
+	 YYCHECK.  */
+      int yyxbegin = yyn < 0 ? -yyn : 0;
+
+      /* Stay within bounds of both yycheck and yytname.  */
+      int yychecklim = YYLAST - yyn + 1;
+      int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+      int yycount = 1;
+
+      yyarg[0] = yytname[yytype];
+      yyfmt = yystpcpy (yyformat, yyunexpected);
+
+      for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+	if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+	  {
+	    if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+	      {
+		yycount = 1;
+		yysize = yysize0;
+		yyformat[sizeof yyunexpected - 1] = '\0';
+		break;
+	      }
+	    yyarg[yycount++] = yytname[yyx];
+	    yysize1 = yysize + yytnamerr (0, yytname[yyx]);
+	    yysize_overflow |= (yysize1 < yysize);
+	    yysize = yysize1;
+	    yyfmt = yystpcpy (yyfmt, yyprefix);
+	    yyprefix = yyor;
+	  }
+
+      yyf = YY_(yyformat);
+      yysize1 = yysize + yystrlen (yyf);
+      yysize_overflow |= (yysize1 < yysize);
+      yysize = yysize1;
+
+      if (yysize_overflow)
+	return YYSIZE_MAXIMUM;
+
+      if (yyresult)
+	{
+	  /* Avoid sprintf, as that infringes on the user's name space.
+	     Don't have undefined behavior even if the translation
+	     produced a string with the wrong number of "%s"s.  */
+	  char *yyp = yyresult;
+	  int yyi = 0;
+	  while ((*yyp = *yyf) != '\0')
+	    {
+	      if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
+		{
+		  yyp += yytnamerr (yyp, yyarg[yyi++]);
+		  yyf += 2;
+		}
+	      else
+		{
+		  yyp++;
+		  yyf++;
+		}
+	    }
+	}
+      return yysize;
+    }
+}
+#endif /* YYERROR_VERBOSE */
+
+
+
+/*-----------------------------------------------.
+| Release the memory associated to this symbol.  |
+`-----------------------------------------------*/
+
+/*ARGSUSED*/
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+static void
+yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep)
+#else
+static void
+yydestruct (yymsg, yytype, yyvaluep)
+    const char *yymsg;
+    int yytype;
+    YYSTYPE *yyvaluep;
+#endif
+{
+  YYUSE (yyvaluep);
+
+  if (!yymsg)
+    yymsg = "Deleting";
+  YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
+
+  switch (yytype)
+    {
+
+      default:
+	break;
+    }
+}
+
+
+
+/* Prevent warnings from -Wmissing-prototypes.  */
+
+#ifdef YYPARSE_PARAM
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void *YYPARSE_PARAM);
+#else
+int yyparse ();
+#endif
+#else /* ! YYPARSE_PARAM */
+#if defined __STDC__ || defined __cplusplus
+int yyparse (void);
+#else
+int yyparse ();
+#endif
+#endif /* ! YYPARSE_PARAM */
+
+
+
+/* The look-ahead symbol.  */
+int yychar;
+
+/* The semantic value of the look-ahead symbol.  */
+YYSTYPE yylval;
+
+/* Number of syntax errors so far.  */
+int yynerrs;
+
+
+
+/*----------.
+| yyparse.  |
+`----------*/
+
+#ifdef YYPARSE_PARAM
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void *YYPARSE_PARAM)
+#else
+int
+yyparse (YYPARSE_PARAM)
+    void *YYPARSE_PARAM;
+#endif
+#else /* ! YYPARSE_PARAM */
+#if (defined __STDC__ || defined __C99__FUNC__ \
+     || defined __cplusplus || defined _MSC_VER)
+int
+yyparse (void)
+#else
+int
+yyparse ()
+
+#endif
+#endif
+{
+  
+  int yystate;
+  int yyn;
+  int yyresult;
+  /* Number of tokens to shift before error messages enabled.  */
+  int yyerrstatus;
+  /* Look-ahead token as an internal (translated) token number.  */
+  int yytoken = 0;
+#if YYERROR_VERBOSE
+  /* Buffer for error messages, and its allocated size.  */
+  char yymsgbuf[128];
+  char *yymsg = yymsgbuf;
+  YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+  /* Three stacks and their tools:
+     `yyss': related to states,
+     `yyvs': related to semantic values,
+     `yyls': related to locations.
+
+     Refer to the stacks thru separate pointers, to allow yyoverflow
+     to reallocate them elsewhere.  */
+
+  /* The state stack.  */
+  yytype_int16 yyssa[YYINITDEPTH];
+  yytype_int16 *yyss = yyssa;
+  yytype_int16 *yyssp;
+
+  /* The semantic value stack.  */
+  YYSTYPE yyvsa[YYINITDEPTH];
+  YYSTYPE *yyvs = yyvsa;
+  YYSTYPE *yyvsp;
+
+
+
+#define YYPOPSTACK(N)   (yyvsp -= (N), yyssp -= (N))
+
+  YYSIZE_T yystacksize = YYINITDEPTH;
+
+  /* The variables used to return semantic value and location from the
+     action routines.  */
+  YYSTYPE yyval;
+
+
+  /* The number of symbols on the RHS of the reduced rule.
+     Keep to zero when no symbol should be popped.  */
+  int yylen = 0;
+
+  YYDPRINTF ((stderr, "Starting parse\n"));
+
+  yystate = 0;
+  yyerrstatus = 0;
+  yynerrs = 0;
+  yychar = YYEMPTY;		/* Cause a token to be read.  */
+
+  /* Initialize stack pointers.
+     Waste one element of value and location stack
+     so that they stay on the same level as the state stack.
+     The wasted elements are never initialized.  */
+
+  yyssp = yyss;
+  yyvsp = yyvs;
+
+  goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate.  |
+`------------------------------------------------------------*/
+ yynewstate:
+  /* In all cases, when you get here, the value and location stacks
+     have just been pushed.  So pushing a state here evens the stacks.  */
+  yyssp++;
+
+ yysetstate:
+  *yyssp = yystate;
+
+  if (yyss + yystacksize - 1 <= yyssp)
+    {
+      /* Get the current used size of the three stacks, in elements.  */
+      YYSIZE_T yysize = yyssp - yyss + 1;
+
+#ifdef yyoverflow
+      {
+	/* Give user a chance to reallocate the stack.  Use copies of
+	   these so that the &'s don't force the real ones into
+	   memory.  */
+	YYSTYPE *yyvs1 = yyvs;
+	yytype_int16 *yyss1 = yyss;
+
+
+	/* Each stack pointer address is followed by the size of the
+	   data in use in that stack, in bytes.  This used to be a
+	   conditional around just the two extra args, but that might
+	   be undefined if yyoverflow is a macro.  */
+	yyoverflow (YY_("memory exhausted"),
+		    &yyss1, yysize * sizeof (*yyssp),
+		    &yyvs1, yysize * sizeof (*yyvsp),
+
+		    &yystacksize);
+
+	yyss = yyss1;
+	yyvs = yyvs1;
+      }
+#else /* no yyoverflow */
+# ifndef YYSTACK_RELOCATE
+      goto yyexhaustedlab;
+# else
+      /* Extend the stack our own way.  */
+      if (YYMAXDEPTH <= yystacksize)
+	goto yyexhaustedlab;
+      yystacksize *= 2;
+      if (YYMAXDEPTH < yystacksize)
+	yystacksize = YYMAXDEPTH;
+
+      {
+	yytype_int16 *yyss1 = yyss;
+	union yyalloc *yyptr =
+	  (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+	if (! yyptr)
+	  goto yyexhaustedlab;
+	YYSTACK_RELOCATE (yyss);
+	YYSTACK_RELOCATE (yyvs);
+
+#  undef YYSTACK_RELOCATE
+	if (yyss1 != yyssa)
+	  YYSTACK_FREE (yyss1);
+      }
+# endif
+#endif /* no yyoverflow */
+
+      yyssp = yyss + yysize - 1;
+      yyvsp = yyvs + yysize - 1;
+
+
+      YYDPRINTF ((stderr, "Stack size increased to %lu\n",
+		  (unsigned long int) yystacksize));
+
+      if (yyss + yystacksize - 1 <= yyssp)
+	YYABORT;
+    }
+
+  YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+
+  goto yybackup;
+
+/*-----------.
+| yybackup.  |
+`-----------*/
+yybackup:
+
+  /* Do appropriate processing given the current state.  Read a
+     look-ahead token if we need one and don't already have one.  */
+
+  /* First try to decide what to do without reference to look-ahead token.  */
+  yyn = yypact[yystate];
+  if (yyn == YYPACT_NINF)
+    goto yydefault;
+
+  /* Not known => get a look-ahead token if don't already have one.  */
+
+  /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol.  */
+  if (yychar == YYEMPTY)
+    {
+      YYDPRINTF ((stderr, "Reading a token: "));
+      yychar = YYLEX;
+    }
+
+  if (yychar <= YYEOF)
+    {
+      yychar = yytoken = YYEOF;
+      YYDPRINTF ((stderr, "Now at end of input.\n"));
+    }
+  else
+    {
+      yytoken = YYTRANSLATE (yychar);
+      YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc);
+    }
+
+  /* If the proper action on seeing token YYTOKEN is to reduce or to
+     detect an error, take that action.  */
+  yyn += yytoken;
+  if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+    goto yydefault;
+  yyn = yytable[yyn];
+  if (yyn <= 0)
+    {
+      if (yyn == 0 || yyn == YYTABLE_NINF)
+	goto yyerrlab;
+      yyn = -yyn;
+      goto yyreduce;
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  /* Count tokens shifted since error; after three, turn off error
+     status.  */
+  if (yyerrstatus)
+    yyerrstatus--;
+
+  /* Shift the look-ahead token.  */
+  YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
+
+  /* Discard the shifted token unless it is eof.  */
+  if (yychar != YYEOF)
+    yychar = YYEMPTY;
+
+  yystate = yyn;
+  *++yyvsp = yylval;
+
+  goto yynewstate;
+
+
+/*-----------------------------------------------------------.
+| yydefault -- do the default action for the current state.  |
+`-----------------------------------------------------------*/
+yydefault:
+  yyn = yydefact[yystate];
+  if (yyn == 0)
+    goto yyerrlab;
+  goto yyreduce;
+
+
+/*-----------------------------.
+| yyreduce -- Do a reduction.  |
+`-----------------------------*/
+yyreduce:
+  /* yyn is the number of a rule to reduce with.  */
+  yylen = yyr2[yyn];
+
+  /* If YYLEN is nonzero, implement the default value of the action:
+     `$$ = $1'.
+
+     Otherwise, the following line sets YYVAL to garbage.
+     This behavior is undocumented and Bison
+     users should not rely upon it.  Assigning to YYVAL
+     unconditionally makes the parser a bit smaller, and it avoids a
+     GCC warning that YYVAL may be used uninitialized.  */
+  yyval = yyvsp[1-yylen];
+
+
+  YY_REDUCE_PRINT (yyn);
+  switch (yyn)
+    {
+        case 5:
+#line 76 "convert.y"
+    { initdimprob(1,(yyvsp[(2) - (3)].na),"0","0"); ;}
+    break;
+
+  case 6:
+#line 77 "convert.y"
+    { initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0"); ;}
+    break;
+
+  case 7:
+#line 78 "convert.y"
+    { initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na)); ;}
+    break;
+
+  case 8:
+#line 80 "convert.y"
+    {
+            listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0);
+            Addmoduletothelist((yyvsp[(2) - (3)].na));
+        ;}
+    break;
+
+  case 9:
+#line 85 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(4) - (5)].na),"4"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,4);
+            }
+            else if (!strcasecmp((yyvsp[(4) - (5)].na),"8"))
+            {
+                listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,8);
+            }
+            else
+            {
+                printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",(yyvsp[(4) - (5)].na));
+                exit(0);
+            }
+        ;}
+    break;
+
+  case 10:
+#line 101 "convert.y"
+    {
+            Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na));
+        ;}
+    break;
+
+  case 11:
+#line 105 "convert.y"
+    {
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS"))      fixedgrids = 1;
+            if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1;
+        ;}
+    break;
+
+
+/* Line 1267 of yacc.c.  */
+#line 1420 "convert.tab.c"
+      default: break;
+    }
+  YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
+
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+
+  *++yyvsp = yyval;
+
+
+  /* Now `shift' the result of the reduction.  Determine what state
+     that goes to, based on the state we popped back to and the rule
+     number reduced by.  */
+
+  yyn = yyr1[yyn];
+
+  yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+  if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+    yystate = yytable[yystate];
+  else
+    yystate = yydefgoto[yyn - YYNTOKENS];
+
+  goto yynewstate;
+
+
+/*------------------------------------.
+| yyerrlab -- here on detecting error |
+`------------------------------------*/
+yyerrlab:
+  /* If not already recovering from an error, report this error.  */
+  if (!yyerrstatus)
+    {
+      ++yynerrs;
+#if ! YYERROR_VERBOSE
+      yyerror (YY_("syntax error"));
+#else
+      {
+	YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
+	if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
+	  {
+	    YYSIZE_T yyalloc = 2 * yysize;
+	    if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
+	      yyalloc = YYSTACK_ALLOC_MAXIMUM;
+	    if (yymsg != yymsgbuf)
+	      YYSTACK_FREE (yymsg);
+	    yymsg = (char *) YYSTACK_ALLOC (yyalloc);
+	    if (yymsg)
+	      yymsg_alloc = yyalloc;
+	    else
+	      {
+		yymsg = yymsgbuf;
+		yymsg_alloc = sizeof yymsgbuf;
+	      }
+	  }
+
+	if (0 < yysize && yysize <= yymsg_alloc)
+	  {
+	    (void) yysyntax_error (yymsg, yystate, yychar);
+	    yyerror (yymsg);
+	  }
+	else
+	  {
+	    yyerror (YY_("syntax error"));
+	    if (yysize != 0)
+	      goto yyexhaustedlab;
+	  }
+      }
+#endif
+    }
+
+
+
+  if (yyerrstatus == 3)
+    {
+      /* If just tried and failed to reuse look-ahead token after an
+	 error, discard it.  */
+
+      if (yychar <= YYEOF)
+	{
+	  /* Return failure if at end of input.  */
+	  if (yychar == YYEOF)
+	    YYABORT;
+	}
+      else
+	{
+	  yydestruct ("Error: discarding",
+		      yytoken, &yylval);
+	  yychar = YYEMPTY;
+	}
+    }
+
+  /* Else will try to reuse look-ahead token after shifting the error
+     token.  */
+  goto yyerrlab1;
+
+
+/*---------------------------------------------------.
+| yyerrorlab -- error raised explicitly by YYERROR.  |
+`---------------------------------------------------*/
+yyerrorlab:
+
+  /* Pacify compilers like GCC when the user code never invokes
+     YYERROR and the label yyerrorlab therefore never appears in user
+     code.  */
+  if (/*CONSTCOND*/ 0)
+     goto yyerrorlab;
+
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYERROR.  */
+  YYPOPSTACK (yylen);
+  yylen = 0;
+  YY_STACK_PRINT (yyss, yyssp);
+  yystate = *yyssp;
+  goto yyerrlab1;
+
+
+/*-------------------------------------------------------------.
+| yyerrlab1 -- common code for both syntax error and YYERROR.  |
+`-------------------------------------------------------------*/
+yyerrlab1:
+  yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+  for (;;)
+    {
+      yyn = yypact[yystate];
+      if (yyn != YYPACT_NINF)
+	{
+	  yyn += YYTERROR;
+	  if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+	    {
+	      yyn = yytable[yyn];
+	      if (0 < yyn)
+		break;
+	    }
+	}
+
+      /* Pop the current state because it cannot handle the error token.  */
+      if (yyssp == yyss)
+	YYABORT;
+
+
+      yydestruct ("Error: popping",
+		  yystos[yystate], yyvsp);
+      YYPOPSTACK (1);
+      yystate = *yyssp;
+      YY_STACK_PRINT (yyss, yyssp);
+    }
+
+  if (yyn == YYFINAL)
+    YYACCEPT;
+
+  *++yyvsp = yylval;
+
+
+  /* Shift the error token.  */
+  YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp);
+
+  yystate = yyn;
+  goto yynewstate;
+
+
+/*-------------------------------------.
+| yyacceptlab -- YYACCEPT comes here.  |
+`-------------------------------------*/
+yyacceptlab:
+  yyresult = 0;
+  goto yyreturn;
+
+/*-----------------------------------.
+| yyabortlab -- YYABORT comes here.  |
+`-----------------------------------*/
+yyabortlab:
+  yyresult = 1;
+  goto yyreturn;
+
+#ifndef yyoverflow
+/*-------------------------------------------------.
+| yyexhaustedlab -- memory exhaustion comes here.  |
+`-------------------------------------------------*/
+yyexhaustedlab:
+  yyerror (YY_("memory exhausted"));
+  yyresult = 2;
+  /* Fall through.  */
+#endif
+
+yyreturn:
+  if (yychar != YYEOF && yychar != YYEMPTY)
+     yydestruct ("Cleanup: discarding lookahead",
+		 yytoken, &yylval);
+  /* Do not reclaim the symbols of the rule which action triggered
+     this YYABORT or YYACCEPT.  */
+  YYPOPSTACK (yylen);
+  YY_STACK_PRINT (yyss, yyssp);
+  while (yyssp != yyss)
+    {
+      yydestruct ("Cleanup: popping",
+		  yystos[*yyssp], yyvsp);
+      YYPOPSTACK (1);
+    }
+#ifndef yyoverflow
+  if (yyss != yyssa)
+    YYSTACK_FREE (yyss);
+#endif
+#if YYERROR_VERBOSE
+  if (yymsg != yymsgbuf)
+    YYSTACK_FREE (yymsg);
+#endif
+  /* Make sure YYID is used.  */
+  return YYID (yyresult);
+}
+
+
+#line 110 "convert.y"
+
+
+void print_usage()
+{
+    printf("usage : conv <config_file> -convfile  <FILENAME>\n");
+    printf(" [-workdir <directory>] [-incdir <directory>]\n");
+    printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
+    printf(" [-convfile  <FILENAME>] [-SubloopScalar] [-SubloopScalar1] \n");
+    printf(" [-free|-fixed]\n");
+    exit(0);
+}
+
+int main(int argc,char *argv[])
+{
+    extern FILE * convert_in ;
+    FILE *dependglobaloutput;
+    int i;
+    listnom *parcours;
+    listvar *newvar;
+    int stylegiven = 0;
+    int infreegiven ;
+    int infixedgiven ;
+    int lengthmainfile;
+
+    char filetoparse[LONG_FNAME];
+
+/******************************************************************************/
+/*  1-  Variables initialization                                              */
+/******************************************************************************/
+    List_Global_Var = (listvar *) NULL;
+    List_GlobalParameter_Var = (listvar *) NULL;
+    List_Common_Var = (listvar *) NULL;
+    List_Allocate_Var = (listallocate *) NULL;
+    List_SubroutineWhereAgrifUsed = (listnom *) NULL;
+    List_Subroutine_For_Alloc = (listnom *) NULL;
+    List_Include = (listusemodule *) NULL;
+    List_NameOfModuleUsed = (listusemodule *) NULL;
+    listofmoduletmp = (listusemodule *) NULL;
+    List_SubroutineDeclaration_Var = (listvar *) NULL;
+    List_UsedInSubroutine_Var = (listvar *) NULL;
+    List_NotGridDepend_Var = (listvar *) NULL;
+    Listofavailableindices = (listindice *) NULL;
+    Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+    List_CouplePointed_Var = (listvarpointtovar *) NULL;
+    List_ModuleUsed_Var = (listvar *) NULL;
+    List_ModuleUsedInModuleUsed_Var = (listvar *) NULL;
+    List_GlobParamModuleUsed_Var = (listparameter *) NULL;
+    List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL;
+    List_SubroutineArgument_Var = (listvar *) NULL;
+    List_FunctionType_Var = (listvar *) NULL;
+    tmpuselocallist = (listusemodule *) NULL;
+    List_ContainsSubroutine = (listnom *) NULL;
+    oldfortran_out = (FILE *) NULL;
+
+    if (argc < 2) print_usage();
+    
+    strcpy(config_file, argv[1]);
+    strcpy(work_dir, ".");
+    strcpy(input_dir, ".");
+    strcpy(output_dir, "AGRIF_MODELFILES");
+    strcpy(include_dir, "AGRIF_INC");
+    strcpy(filetoparse, "");
+    strcpy(subofagrifinitgrids, "");
+    strcpy(meetagrifinitgrids, "");
+    strcpy(mpiinitvar, "");
+
+    length_last = 0 ;
+    length_first = 0 ;
+    length_v_vallengspec = 0 ;
+    length_v_commoninfile = 0 ;
+    length_v_precision = 0 ;
+    length_v_IntentSpec = 0 ;
+    length_v_initialvalue = 0 ;
+    length_v_readedlistdimension = 0 ;
+    length_a_nomvar = 0 ;
+    length_toprintglob = 0 ;
+    length_tmpvargridname = 0 ;
+    length_ligne_Subloop = 0 ;
+    length_toprint_utilagrif = 0 ;
+    length_toprinttmp_utilchar = 0 ;
+    length_ligne_writedecl = 0 ;
+    length_newname_toamr = 0 ;
+    length_newname_writedecl = 0 ;
+    length_ligne_toamr = 0 ;
+    length_tmpligne_writedecl = 0 ;
+    value_char_size = 0 ;
+    value_char_size1 = 0 ;
+    value_char_size2 = 0 ;
+    value_char_size3 = 0 ;
+    inallocate = 0;
+    infixed = 1;
+    infree  = 0;
+
+    onlyfixedgrids=0;
+    fixedgrids=0;
+    InAgrifParentDef = 0;
+    IndicenbmaillesX=0;
+    IndicenbmaillesY=0;
+    IndicenbmaillesZ=0;
+    created_dimensionlist = 1;
+    /* current indice in the table tabvars             */
+    for ( i=0 ; i<NB_CAT_VARIABLES ; i++)
+    {
+        indicemaxtabvars[i] = 0;
+    }
+    SubloopScalar = 0;
+    todebug = 0;
+    retour77 = 1 ;
+    shouldincludempif = 0 ;
+
+    Read_val_max();
+
+/******************************************************************************/
+/*  2-  Program arguments                                                     */
+/******************************************************************************/
+
+    if ( (convert_in=fopen(config_file,"r")) == NULL )
+    {
+        printf("##\n## ERROR: the configuration file '%s' doesn't exist.\n##\n", config_file);
+        print_usage();
+    }
+
+    i=2;
+    while ( i < argc )
+    {
+        if (!strcasecmp(argv[i], "-workdir"))
+        {
+            strcpy(work_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-incdir"))
+        {
+            strcpy(include_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirin")) /* input directory           */
+        {
+            strcpy(input_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-comdirout")) /* output directory         */
+        {
+            strcpy(output_dir,argv[i+1]);
+            i++;
+        }
+        else if (!strcasecmp(argv[i], "-convfile")) /* file to parse             */
+        {
+            strcpy(filetoparse, argv[i+1]);
+            i++;
+            lengthmainfile = strlen(filetoparse);
+            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
+            {
+                infixed = 0;
+                infree = 1;
+            }
+            else
+            {
+                infixed = 1;
+                infree = 0;
+            }
+        }
+        else if (!strcasecmp(argv[i], "-free"))
+        {
+            stylegiven = 1;
+            infreegiven  = 1 ;
+            infixedgiven = 0;
+        }
+        else if (!strcasecmp(argv[i], "-fixed"))
+        {
+            stylegiven = 1;
+            infreegiven  = 0;
+            infixedgiven = 1;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar"))
+        {
+            SubloopScalar = 1 ;
+        }
+        else if (!strcasecmp(argv[i], "-SubloopScalar1"))
+        {
+            SubloopScalar = 2 ;
+        }
+        else if (!strcasecmp(argv[i], "-todebug"))
+        {
+            todebug = 1 ;
+        }
+        else if (!strcasecmp(argv[i],"-rm")) { }
+        else
+        {
+            printf("##\n## Unkwon option : %s\n##\n", argv[i]);
+            exit(0);
+        }
+        i++;
+    }
+    // Check input file
+    if ( strlen(filetoparse) == 0 )         // -convfile has not been specified
+    {
+        printf("##\n## ERROR: please provide a file to parse with -convfile.\n##\n");
+        print_usage();
+    }
+    // Setup input & output directories
+    if ( strcasecmp(work_dir, ".") != 0 )   // -workdir has been changed...
+    {
+        if ( strcasecmp(input_dir,  ".") == 0 )                 // ...and -comdirin  has NOT been changed
+        {
+            strcpy(input_dir, work_dir);
+        }
+        if ( strcasecmp(output_dir, "AGRIF_MODELFILES") == 0 )  // ...and -comdirout has NOT been changed
+        {
+            sprintf(output_dir, "%s/%s", work_dir, "AGRIF_MODELFILES");
+        }
+        if ( strcasecmp(include_dir, "AGRIF_INC") == 0 )        // ...and -incdir    has NOT been changed
+        {
+            sprintf(include_dir, "%s/%s", work_dir, "AGRIF_INC");
+        }
+    }
+    if (stylegiven == 1)
+    {
+        infree  = infreegiven;
+        infixed = infixedgiven;
+    }
+
+/******************************************************************************/
+/*  3-  Parsing of the conv file <name>.in                                    */
+/******************************************************************************/
+
+    if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0;
+
+    convert_parse();
+
+/******************************************************************************/
+/*  4-  Preparation of the file parsing                                       */
+/******************************************************************************/
+
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    /*                                                                         */
+    if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL )
+    {
+        for (i=0;i<NB_CAT_VARIABLES;i++)
+        {
+            fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars[i]);
+        }
+        fclose(dependglobaloutput);
+    }
+    Readthedependavailablefile();
+    /* Read the .dependnbxnby file which contains indices of nbmaillsX, nbmailleY and nbmailleZ */
+    Readthedependnbxnbyfile();
+    Read_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  5-  Parsing of the input file (2 times)                                   */
+/******************************************************************************/
+
+    /* Record all variables in list                                            */
+    firstpass = 1;
+    process_fortran(filetoparse);
+
+    CompleteThelistvarindoloop();
+    /* Read list of module used                                                */
+    RecordUseModulesVariables();
+    /* Read list of module used in module used                                 */
+    RecordUseModulesUseModulesVariables();
+    /* Save variables are considered as globals ones                           */
+    Update_List_Global_Var_From_List_Save_Var();
+    /* Update all lists                                                        */
+    ListUpdate();
+
+    Clean_List_Global_Var();
+    /* Indice tabvars identification                                           */
+    IndiceTabvarsIdentification();
+    /* Update all lists                                                        */
+    ListUpdate();
+    /* The allocation subroutine is necessary ????                             */
+    New_Allocate_Subroutine_Is_Necessary();
+    /* The allocation subroutine is necessary for common list                  */
+    New_Allocate_Subroutine_For_Common_Is_Necessary();
+    /* Sort List_SubroutineArgument_Var                                        */
+    Sort_List_SubroutineArgument_Var();
+    /* Clean all lists                                                         */
+    ListClean();
+    /* Update Indice of List_UsedInSubroutine_Var from module used             */
+    List_UsedInSubroutine_Var_Update_From_Module_Used();
+    /* Update List_SubroutineWhereAgrifUsed                                    */
+    UpdateList_SubroutineWhereAgrifUsed();
+    /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
+    UpdateList_UsedInSubroutine_With_dimension();
+
+    ModifyThelistvarindoloop();
+    UpdateListDeclarationWithDimensionList();
+    GiveTypeOfVariables();
+
+    /* Build new subroutines                                                   */
+    firstpass = 0;
+    process_fortran(filetoparse);
+
+    newvar = (listvar *) NULL;
+
+    while ( newvar )
+    {
+        printf("++++ %s %d %s %s %s\n",
+            newvar->var->v_nomvar,
+            newvar->var->v_nbdim,
+            newvar->var->v_subroutinename,
+            newvar->var->v_modulename,
+            newvar->var->v_typevar);
+        newvar = newvar->suiv;
+    }
+
+/******************************************************************************/
+/*  6-  Write informations in output files                                    */
+/******************************************************************************/
+
+    /* Write the .dependglobal_agrif file which contain the max indice         */
+    /*    of the tabvars table                                                 */
+    sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir);
+    dependglobaloutput = fopen(dependfilename, "w");
+    for (i=0;i<NB_CAT_VARIABLES;i++)
+    {
+        fprintf(dependglobaloutput,"%d\n",indicemaxtabvars[i]);
+    }
+    fclose(dependglobaloutput);
+    /* Write the list of available indice                                      */
+    Writethedependavailablefile();
+    /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
+    /*    nbmailleY and nbmailleZ                                              */
+    Writethedependnbxnbyfile();
+    /* Write the .depend<namefile> file which contain general informations     */
+    /*    about variable of this file                                          */
+    parcours = List_NameOfModule;
+    while( parcours )
+    {
+        Writethedependlistofmoduleused(parcours->o_nom);
+        WritedependParameterList(parcours->o_nom);
+        Writethedependfile(parcours->o_nom,List_Global_Var);
+        parcours=parcours->suiv;
+    }
+    parcours = List_NameOfCommon;
+    while( parcours )
+    {
+        Writethedependfile(parcours->o_nom,List_Common_Var);
+        parcours=parcours->suiv;
+    }
+    Write_Subroutine_For_Alloc();
+
+/******************************************************************************/
+/*  7-  Create files in AGRIF_INC directory                                   */
+/******************************************************************************/
+
+    creefichieramr();
+
+    Write_val_max();
+
+    if ( todebug == 1 ) printf("Out of CONV \n");
+    return 0;
+}
+
+#line 2 "convert.yy.c"
+
+#line 4 "convert.yy.c"
+
+#define  YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define yy_create_buffer convert__create_buffer
+#define yy_delete_buffer convert__delete_buffer
+#define yy_flex_debug convert__flex_debug
+#define yy_init_buffer convert__init_buffer
+#define yy_flush_buffer convert__flush_buffer
+#define yy_load_buffer_state convert__load_buffer_state
+#define yy_switch_to_buffer convert__switch_to_buffer
+#define yyin convert_in
+#define yyleng convert_leng
+#define yylex convert_lex
+#define yylineno convert_lineno
+#define yyout convert_out
+#define yyrestart convert_restart
+#define yytext convert_text
+#define yywrap convert_wrap
+#define yyalloc convert_alloc
+#define yyrealloc convert_realloc
+#define yyfree convert_free
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 5
+#define YY_FLEX_SUBMINOR_VERSION 35
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with  platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types. 
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+typedef uint64_t flex_uint64_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t; 
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+#endif /* ! C99 */
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN               (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN              (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN              (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX               (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX              (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX              (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX              (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX             (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX             (4294967295U)
+#endif
+
+#endif /* ! FLEXINT_H */
+
+#ifdef __cplusplus
+
+/* The "const" storage-class-modifier is valid. */
+#define YY_USE_CONST
+
+#else	/* ! __cplusplus */
+
+/* C99 requires __STDC__ to be defined as 1. */
+#if defined (__STDC__)
+
+#define YY_USE_CONST
+
+#endif	/* defined (__STDC__) */
+#endif	/* ! __cplusplus */
+
+#ifdef YY_USE_CONST
+#define yyconst const
+#else
+#define yyconst
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an unsigned
+ * integer for use as an array index.  If the signed char is negative,
+ * we want to instead treat it as an 8-bit unsigned char, hence the
+ * double cast.
+ */
+#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c)
+
+/* Enter a start condition.  This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state.  The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE convert_restart(convert_in  )
+
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#define YY_BUF_SIZE 16384
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE   ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern yy_size_t convert_leng;
+
+extern FILE *convert_in, *convert_out;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+    #define YY_LESS_LINENO(n)
+    
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up convert_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		*yy_cp = (yy_hold_char); \
+		YY_RESTORE_YY_MORE_OFFSET \
+		(yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+		YY_DO_BEFORE_ACTION; /* set up convert_text again */ \
+		} \
+	while ( 0 )
+
+#define unput(c) yyunput( c, (yytext_ptr)  )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+	{
+	FILE *yy_input_file;
+
+	char *yy_ch_buf;		/* input buffer */
+	char *yy_buf_pos;		/* current position in input buffer */
+
+	/* Size of input buffer in bytes, not including room for EOB
+	 * characters.
+	 */
+	yy_size_t yy_buf_size;
+
+	/* Number of characters read into yy_ch_buf, not including EOB
+	 * characters.
+	 */
+	yy_size_t yy_n_chars;
+
+	/* Whether we "own" the buffer - i.e., we know we created it,
+	 * and can realloc() it to grow it, and should free() it to
+	 * delete it.
+	 */
+	int yy_is_our_buffer;
+
+	/* Whether this is an "interactive" input source; if so, and
+	 * if we're using stdio for input, then we want to use getc()
+	 * instead of fread(), to make sure we stop fetching input after
+	 * each newline.
+	 */
+	int yy_is_interactive;
+
+	/* Whether we're considered to be at the beginning of a line.
+	 * If so, '^' rules will be active on the next match, otherwise
+	 * not.
+	 */
+	int yy_at_bol;
+
+    int yy_bs_lineno; /**< The line count. */
+    int yy_bs_column; /**< The column count. */
+    
+	/* Whether to try to fill the input buffer when we reach the
+	 * end of it.
+	 */
+	int yy_fill_buffer;
+
+	int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+	/* When an EOF's been seen but there's still some text to process
+	 * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+	 * shouldn't try reading from the input source any more.  We might
+	 * still have a bunch of tokens to match, though, because of
+	 * possible backing-up.
+	 *
+	 * When we actually see the EOF, we change the status to "new"
+	 * (via convert_restart()), so that the user can continue scanning by
+	 * just pointing convert_in at a new input file.
+	 */
+#define YY_BUFFER_EOF_PENDING 2
+
+	};
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+                          ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+                          : NULL)
+
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when convert_text is formed. */
+static char yy_hold_char;
+static yy_size_t yy_n_chars;		/* number of characters read into yy_ch_buf */
+yy_size_t convert_leng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = (char *) 0;
+static int yy_init = 0;		/* whether we need to initialize */
+static int yy_start = 0;	/* start state number */
+
+/* Flag which is used to allow convert_wrap()'s to do buffer switches
+ * instead of setting up a fresh convert_in.  A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void convert_restart (FILE *input_file  );
+void convert__switch_to_buffer (YY_BUFFER_STATE new_buffer  );
+YY_BUFFER_STATE convert__create_buffer (FILE *file,int size  );
+void convert__delete_buffer (YY_BUFFER_STATE b  );
+void convert__flush_buffer (YY_BUFFER_STATE b  );
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer  );
+void convert_pop_buffer_state (void );
+
+static void convert_ensure_buffer_stack (void );
+static void convert__load_buffer_state (void );
+static void convert__init_buffer (YY_BUFFER_STATE b,FILE *file  );
+
+#define YY_FLUSH_BUFFER convert__flush_buffer(YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE convert__scan_buffer (char *base,yy_size_t size  );
+YY_BUFFER_STATE convert__scan_string (yyconst char *yy_str  );
+YY_BUFFER_STATE convert__scan_bytes (yyconst char *bytes,yy_size_t len  );
+
+void *convert_alloc (yy_size_t  );
+void *convert_realloc (void *,yy_size_t  );
+void convert_free (void *  );
+
+#define yy_new_buffer convert__create_buffer
+
+#define yy_set_interactive(is_interactive) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){ \
+        convert_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+	}
+
+#define yy_set_bol(at_bol) \
+	{ \
+	if ( ! YY_CURRENT_BUFFER ){\
+        convert_ensure_buffer_stack (); \
+		YY_CURRENT_BUFFER_LVALUE =    \
+            convert__create_buffer(convert_in,YY_BUF_SIZE ); \
+	} \
+	YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+	}
+
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+
+#define convert_wrap(n) 1
+#define YY_SKIP_YYWRAP
+
+typedef unsigned char YY_CHAR;
+
+FILE *convert_in = (FILE *) 0, *convert_out = (FILE *) 0;
+
+typedef int yy_state_type;
+
+extern int convert_lineno;
+
+int convert_lineno = 1;
+
+extern char *convert_text;
+#define yytext_ptr convert_text
+
+static yy_state_type yy_get_previous_state (void );
+static yy_state_type yy_try_NUL_trans (yy_state_type current_state  );
+static int yy_get_next_buffer (void );
+static void yy_fatal_error (yyconst char msg[]  );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up convert_text.
+ */
+#define YY_DO_BEFORE_ACTION \
+	(yytext_ptr) = yy_bp; \
+	convert_leng = (yy_size_t) (yy_cp - yy_bp); \
+	(yy_hold_char) = *yy_cp; \
+	*yy_cp = '\0'; \
+	(yy_c_buf_p) = yy_cp;
+
+#define YY_NUM_RULES 15
+#define YY_END_OF_BUFFER 16
+/* This struct is not used in this scanner,
+   but its presence is necessary. */
+struct yy_trans_info
+	{
+	flex_int32_t yy_verify;
+	flex_int32_t yy_nxt;
+	};
+static yyconst flex_int16_t yy_accept[84] =
+    {   0,
+        0,    0,    0,    0,   16,   15,   14,   13,   15,   12,
+       11,   11,   11,   11,   12,    7,   10,   10,   10,   10,
+       10,   10,   10,   14,    0,    4,   11,    9,    9,    9,
+        5,   10,   10,   10,   10,   10,   10,   10,   10,    8,
+       10,   10,   10,   10,   10,    3,   10,    6,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,   10,   10,   10,   10,   10,   10,   10,   10,
+       10,   10,    2,   10,   10,   10,    1,   10,   10,   10,
+       10,    8,    0
+    } ;
+
+static yyconst flex_int32_t yy_ec[256] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    2,    3,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    2,    1,    1,    1,    1,    4,    1,    1,    5,
+        6,    1,    1,    7,    1,    1,    1,    8,    9,   10,
+       11,    8,    8,    8,   12,    8,    8,   13,   14,    1,
+       15,    1,    1,    1,   16,   17,   17,   18,   19,   20,
+       21,   17,   22,   17,   23,   24,   25,   26,   27,   28,
+       17,   29,   30,   31,   32,   17,   17,   33,   34,   17,
+       35,    1,   36,    1,   37,    1,   38,   17,   17,   39,
+
+       40,   41,   42,   17,   43,   17,   44,   45,   46,   47,
+       48,   49,   17,   50,   51,   52,   53,   17,   17,   54,
+       55,   17,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1
+    } ;
+
+static yyconst flex_int32_t yy_meta[56] =
+    {   0,
+        1,    1,    2,    1,    1,    1,    1,    3,    3,    3,
+        3,    3,    1,    1,    1,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    1,    1,    3,    3,    3,    3,
+        3,    3,    3,    3,    3,    3,    3,    3,    3,    3,
+        3,    3,    3,    3,    3
+    } ;
+
+static yyconst flex_int16_t yy_base[86] =
+    {   0,
+        0,    0,    0,    0,  192,  194,  186,  194,  176,  194,
+       48,   53,   58,   69,  164,  194,    0,   60,   51,   47,
+       49,   67,   55,  173,  170,  169,   90,  194,  194,  194,
+      194,    0,  160,   53,   62,   58,   66,   62,   74,    0,
+       85,   95,   94,   82,  101,    0,  101,    0,   91,  134,
+       96,  133,  100,  103,   99,  105,  109,  106,  102,  101,
+      113,   99,  115,  113,  119,  127,  123,  139,  130,  142,
+      137,  132,    0,   81,  144,  143,    0,  136,  144,  150,
+      139,    0,  194,  190,   81
+    } ;
+
+static yyconst flex_int16_t yy_def[86] =
+    {   0,
+       83,    1,    1,    1,   83,   83,   83,   83,   84,   83,
+       83,   83,   83,   83,   83,   83,   85,   85,   85,   85,
+       85,   85,   85,   83,   84,   84,   83,   83,   83,   83,
+       83,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,   85,   85,   85,   85,   85,   85,   85,   85,
+       85,   85,    0,   83,   83
+    } ;
+
+static yyconst flex_int16_t yy_nxt[250] =
+    {   0,
+        6,    7,    8,    9,   10,   10,   10,   11,   12,   13,
+       14,   11,   15,   10,   16,   17,   17,   17,   17,   18,
+       17,   17,   19,   17,   17,   20,   21,   22,   17,   17,
+       17,   23,   17,   17,   10,   10,   17,   17,   17,   17,
+       18,   17,   17,   19,   17,   17,   20,   21,   22,   17,
+       17,   17,   23,   17,   17,   27,   27,   27,   27,   27,
+       27,   27,   27,   27,   27,   27,   27,   27,   27,   27,
+       28,   33,   35,   36,   37,   29,   27,   27,   27,   27,
+       27,   34,   38,   32,   39,   41,   30,   42,   43,   44,
+       45,   28,   46,   35,   36,   37,   29,   27,   27,   27,
+
+       27,   27,   34,   47,   38,   39,   41,   30,   42,   43,
+       44,   45,   48,   46,   49,   50,   51,   76,   52,   53,
+       55,   57,   58,   59,   47,   60,   61,   62,   63,   64,
+       65,   66,   67,   48,   68,   49,   50,   69,   51,   52,
+       53,   55,   57,   58,   59,   70,   60,   61,   62,   63,
+       64,   65,   66,   67,   71,   68,   72,   73,   69,   74,
+       75,   40,   77,   78,   79,   80,   70,   81,   82,   56,
+       54,   40,   26,   26,   24,   71,   31,   72,   73,   26,
+       74,   75,   40,   77,   78,   79,   80,   24,   81,   82,
+       25,   83,   25,    5,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
+    } ;
+
+static yyconst flex_int16_t yy_chk[250] =
+    {   0,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,    1,    1,    1,    1,    1,
+        1,    1,    1,    1,    1,   11,   11,   11,   11,   11,
+       12,   12,   12,   12,   12,   13,   13,   13,   13,   13,
+       12,   18,   19,   20,   21,   13,   14,   14,   14,   14,
+       14,   18,   22,   85,   23,   34,   14,   35,   36,   37,
+       38,   12,   39,   19,   20,   21,   13,   27,   27,   27,
+
+       27,   27,   18,   41,   22,   23,   34,   14,   35,   36,
+       37,   38,   42,   39,   43,   44,   45,   74,   47,   49,
+       51,   53,   54,   55,   41,   56,   57,   58,   59,   60,
+       61,   62,   63,   42,   64,   43,   44,   65,   45,   47,
+       49,   51,   53,   54,   55,   66,   56,   57,   58,   59,
+       60,   61,   62,   63,   67,   64,   68,   69,   65,   70,
+       71,   72,   75,   76,   78,   79,   66,   80,   81,   52,
+       50,   33,   26,   25,   24,   67,   15,   68,   69,    9,
+       70,   71,   72,   75,   76,   78,   79,    7,   80,   81,
+       84,    5,   84,   83,   83,   83,   83,   83,   83,   83,
+
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83,   83,
+       83,   83,   83,   83,   83,   83,   83,   83,   83
+    } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int convert__flex_debug;
+int convert__flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *convert_text;
+#line 1 "convert.lex"
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+
+#line 40 "convert.lex"
+#include <math.h>
+#include <stdlib.h>
+#include <string.h>
+
+#define YY_NO_INPUT
+#line 595 "convert.yy.c"
+
+#define INITIAL 0
+#define character 1
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals (void );
+
+/* Accessor methods to globals.
+   These are made visible to non-reentrant scanners for convenience. */
+
+int convert_lex_destroy (void );
+
+int convert_get_debug (void );
+
+void convert_set_debug (int debug_flag  );
+
+YY_EXTRA_TYPE convert_get_extra (void );
+
+void convert_set_extra (YY_EXTRA_TYPE user_defined  );
+
+FILE *convert_get_in (void );
+
+void convert_set_in  (FILE * in_str  );
+
+FILE *convert_get_out (void );
+
+void convert_set_out  (FILE * out_str  );
+
+yy_size_t convert_get_leng (void );
+
+char *convert_get_text (void );
+
+int convert_get_lineno (void );
+
+void convert_set_lineno (int line_number  );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int convert_wrap (void );
+#else
+extern int convert_wrap (void );
+#endif
+#endif
+
+    static void yyunput (int c,char *buf_ptr  );
+    
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char *,yyconst char *,int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * );
+#endif
+
+#ifndef YY_NO_INPUT
+
+#ifdef __cplusplus
+static int yyinput (void );
+#else
+static int input (void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#define YY_READ_BUF_SIZE 8192
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO fwrite( convert_text, convert_leng, 1, convert_out )
+#endif
+
+/* Gets input and stuffs it into "buf".  number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+		{ \
+		int c = '*'; \
+		yy_size_t n; \
+		for ( n = 0; n < max_size && \
+			     (c = getc( convert_in )) != EOF && c != '\n'; ++n ) \
+			buf[n] = (char) c; \
+		if ( c == '\n' ) \
+			buf[n++] = (char) c; \
+		if ( c == EOF && ferror( convert_in ) ) \
+			YY_FATAL_ERROR( "input in flex scanner failed" ); \
+		result = n; \
+		} \
+	else \
+		{ \
+		errno=0; \
+		while ( (result = fread(buf, 1, max_size, convert_in))==0 && ferror(convert_in)) \
+			{ \
+			if( errno != EINTR) \
+				{ \
+				YY_FATAL_ERROR( "input in flex scanner failed" ); \
+				break; \
+				} \
+			errno=0; \
+			clearerr(convert_in); \
+			} \
+		}\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int convert_lex (void);
+
+#define YY_DECL int convert_lex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after convert_text and convert_leng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK break;
+#endif
+
+#define YY_RULE_SETUP \
+	YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp, *yy_bp;
+	register int yy_act;
+    
+#line 54 "convert.lex"
+
+#line 780 "convert.yy.c"
+
+	if ( !(yy_init) )
+		{
+		(yy_init) = 1;
+
+#ifdef YY_USER_INIT
+		YY_USER_INIT;
+#endif
+
+		if ( ! (yy_start) )
+			(yy_start) = 1;	/* first start state */
+
+		if ( ! convert_in )
+			convert_in = stdin;
+
+		if ( ! convert_out )
+			convert_out = stdout;
+
+		if ( ! YY_CURRENT_BUFFER ) {
+			convert_ensure_buffer_stack ();
+			YY_CURRENT_BUFFER_LVALUE =
+				convert__create_buffer(convert_in,YY_BUF_SIZE );
+		}
+
+		convert__load_buffer_state( );
+		}
+
+	while ( 1 )		/* loops until end-of-file is reached */
+		{
+		yy_cp = (yy_c_buf_p);
+
+		/* Support of convert_text. */
+		*yy_cp = (yy_hold_char);
+
+		/* yy_bp points to the position in yy_ch_buf of the start of
+		 * the current run.
+		 */
+		yy_bp = yy_cp;
+
+		yy_current_state = (yy_start);
+yy_match:
+		do
+			{
+			register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)];
+			if ( yy_accept[yy_current_state] )
+				{
+				(yy_last_accepting_state) = yy_current_state;
+				(yy_last_accepting_cpos) = yy_cp;
+				}
+			while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+				{
+				yy_current_state = (int) yy_def[yy_current_state];
+				if ( yy_current_state >= 84 )
+					yy_c = yy_meta[(unsigned int) yy_c];
+				}
+			yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+			++yy_cp;
+			}
+		while ( yy_base[yy_current_state] != 194 );
+
+yy_find_action:
+		yy_act = yy_accept[yy_current_state];
+		if ( yy_act == 0 )
+			{ /* have to back up */
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			yy_act = yy_accept[yy_current_state];
+			}
+
+		YY_DO_BEFORE_ACTION;
+
+do_action:	/* This label is used only to access EOF actions. */
+
+		switch ( yy_act )
+	{ /* beginning of action switch */
+			case 0: /* must back up */
+			/* undo the effects of YY_DO_BEFORE_ACTION */
+			*yy_cp = (yy_hold_char);
+			yy_cp = (yy_last_accepting_cpos);
+			yy_current_state = (yy_last_accepting_state);
+			goto yy_find_action;
+
+case 1:
+YY_RULE_SETUP
+#line 55 "convert.lex"
+{ return TOK_MODULEMAIN; } /* name of the module                      */
+	YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 56 "convert.lex"
+{ return TOK_NOTGRIDDEP; } /* variable which are not grid dependent   */
+	YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 57 "convert.lex"
+{ return TOK_USE; }
+	YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 58 "convert.lex"
+{ }
+	YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 59 "convert.lex"
+{ return TOK_SEP; }
+	YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 60 "convert.lex"
+{ return TOK_KIND; }
+	YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 61 "convert.lex"
+{ return TOK_EQUAL; }
+	YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 62 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_USEITEM;  }
+	YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 63 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_PROBTYPE; }  /* dimension of the problem */
+	YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 64 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_NAME; }
+	YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 65 "convert.lex"
+{ strcpy(yylval.na,convert_text); return TOK_CSTINT; }
+	YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 66 "convert.lex"
+{ return (int) *convert_text; }
+	YY_BREAK
+case 13:
+/* rule 13 can match eol */
+YY_RULE_SETUP
+#line 67 "convert.lex"
+{ line_num++; return (int) *convert_text; }
+	YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 68 "convert.lex"
+;
+	YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 69 "convert.lex"
+ECHO;
+	YY_BREAK
+#line 939 "convert.yy.c"
+case YY_STATE_EOF(INITIAL):
+case YY_STATE_EOF(character):
+	yyterminate();
+
+	case YY_END_OF_BUFFER:
+		{
+		/* Amount of text matched not including the EOB char. */
+		int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+		/* Undo the effects of YY_DO_BEFORE_ACTION. */
+		*yy_cp = (yy_hold_char);
+		YY_RESTORE_YY_MORE_OFFSET
+
+		if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+			{
+			/* We're scanning a new file or input source.  It's
+			 * possible that this happened because the user
+			 * just pointed convert_in at a new source and called
+			 * convert_lex().  If so, then we have to assure
+			 * consistency between YY_CURRENT_BUFFER and our
+			 * globals.  Here is the right place to do so, because
+			 * this is the first action (other than possibly a
+			 * back-up) that will match for the new input source.
+			 */
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+			YY_CURRENT_BUFFER_LVALUE->yy_input_file = convert_in;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+			}
+
+		/* Note that here we test for yy_c_buf_p "<=" to the position
+		 * of the first EOB in the buffer, since yy_c_buf_p will
+		 * already have been incremented past the NUL character
+		 * (since all states make transitions on EOB to the
+		 * end-of-buffer state).  Contrast this with the test
+		 * in input().
+		 */
+		if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			{ /* This was really a NUL. */
+			yy_state_type yy_next_state;
+
+			(yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+			yy_current_state = yy_get_previous_state(  );
+
+			/* Okay, we're now positioned to make the NUL
+			 * transition.  We couldn't have
+			 * yy_get_previous_state() go ahead and do it
+			 * for us because it doesn't know how to deal
+			 * with the possibility of jamming (and we don't
+			 * want to build jamming into it because then it
+			 * will run more slowly).
+			 */
+
+			yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+			yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+			if ( yy_next_state )
+				{
+				/* Consume the NUL. */
+				yy_cp = ++(yy_c_buf_p);
+				yy_current_state = yy_next_state;
+				goto yy_match;
+				}
+
+			else
+				{
+				yy_cp = (yy_c_buf_p);
+				goto yy_find_action;
+				}
+			}
+
+		else switch ( yy_get_next_buffer(  ) )
+			{
+			case EOB_ACT_END_OF_FILE:
+				{
+				(yy_did_buffer_switch_on_eof) = 0;
+
+				if ( convert_wrap( ) )
+					{
+					/* Note: because we've taken care in
+					 * yy_get_next_buffer() to have set up
+					 * convert_text, we can now set up
+					 * yy_c_buf_p so that if some total
+					 * hoser (like flex itself) wants to
+					 * call the scanner after we return the
+					 * YY_NULL, it'll still work - another
+					 * YY_NULL will get returned.
+					 */
+					(yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+					yy_act = YY_STATE_EOF(YY_START);
+					goto do_action;
+					}
+
+				else
+					{
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+					}
+				break;
+				}
+
+			case EOB_ACT_CONTINUE_SCAN:
+				(yy_c_buf_p) =
+					(yytext_ptr) + yy_amount_of_matched_text;
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_match;
+
+			case EOB_ACT_LAST_MATCH:
+				(yy_c_buf_p) =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+				yy_current_state = yy_get_previous_state(  );
+
+				yy_cp = (yy_c_buf_p);
+				yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+				goto yy_find_action;
+			}
+		break;
+		}
+
+	default:
+		YY_FATAL_ERROR(
+			"fatal flex scanner internal error--no action found" );
+	} /* end of action switch */
+		} /* end of scanning one token */
+} /* end of convert_lex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ *	EOB_ACT_LAST_MATCH -
+ *	EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ *	EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+    	register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+	register char *source = (yytext_ptr);
+	register int number_to_move, i;
+	int ret_val;
+
+	if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+		YY_FATAL_ERROR(
+		"fatal flex scanner internal error--end of buffer missed" );
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+		{ /* Don't try to fill the buffer, so this is an EOF. */
+		if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+			{
+			/* We matched a single character, the EOB, so
+			 * treat this as a final EOF.
+			 */
+			return EOB_ACT_END_OF_FILE;
+			}
+
+		else
+			{
+			/* We matched some text prior to the EOB, first
+			 * process it.
+			 */
+			return EOB_ACT_LAST_MATCH;
+			}
+		}
+
+	/* Try to read more data. */
+
+	/* First move last chars to start of buffer. */
+	number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1;
+
+	for ( i = 0; i < number_to_move; ++i )
+		*(dest++) = *(source++);
+
+	if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+		/* don't do the read, it's not guaranteed to return an EOF,
+		 * just force an EOF
+		 */
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+	else
+		{
+			yy_size_t num_to_read =
+			YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+		while ( num_to_read <= 0 )
+			{ /* Not enough room in the buffer - grow it. */
+
+			/* just a shorter name for the current buffer */
+			YY_BUFFER_STATE b = YY_CURRENT_BUFFER;
+
+			int yy_c_buf_p_offset =
+				(int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+			if ( b->yy_is_our_buffer )
+				{
+				yy_size_t new_size = b->yy_buf_size * 2;
+
+				if ( new_size <= 0 )
+					b->yy_buf_size += b->yy_buf_size / 8;
+				else
+					b->yy_buf_size *= 2;
+
+				b->yy_ch_buf = (char *)
+					/* Include room in for 2 EOB chars. */
+					convert_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2  );
+				}
+			else
+				/* Can't grow it, we don't own it. */
+				b->yy_ch_buf = 0;
+
+			if ( ! b->yy_ch_buf )
+				YY_FATAL_ERROR(
+				"fatal error - scanner input buffer overflow" );
+
+			(yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+			num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+						number_to_move - 1;
+
+			}
+
+		if ( num_to_read > YY_READ_BUF_SIZE )
+			num_to_read = YY_READ_BUF_SIZE;
+
+		/* Read in more data. */
+		YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+			(yy_n_chars), num_to_read );
+
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	if ( (yy_n_chars) == 0 )
+		{
+		if ( number_to_move == YY_MORE_ADJ )
+			{
+			ret_val = EOB_ACT_END_OF_FILE;
+			convert_restart(convert_in  );
+			}
+
+		else
+			{
+			ret_val = EOB_ACT_LAST_MATCH;
+			YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+				YY_BUFFER_EOF_PENDING;
+			}
+		}
+
+	else
+		ret_val = EOB_ACT_CONTINUE_SCAN;
+
+	if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+		/* Extend the array by 50%, plus the number we really need. */
+		yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+		YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) convert_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size  );
+		if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+	}
+
+	(yy_n_chars) += number_to_move;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+	YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+	(yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+	return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+    static yy_state_type yy_get_previous_state (void)
+{
+	register yy_state_type yy_current_state;
+	register char *yy_cp;
+    
+	yy_current_state = (yy_start);
+
+	for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+		{
+		register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+		if ( yy_accept[yy_current_state] )
+			{
+			(yy_last_accepting_state) = yy_current_state;
+			(yy_last_accepting_cpos) = yy_cp;
+			}
+		while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+			{
+			yy_current_state = (int) yy_def[yy_current_state];
+			if ( yy_current_state >= 84 )
+				yy_c = yy_meta[(unsigned int) yy_c];
+			}
+		yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+		}
+
+	return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ *	next_state = yy_try_NUL_trans( current_state );
+ */
+    static yy_state_type yy_try_NUL_trans  (yy_state_type yy_current_state )
+{
+	register int yy_is_jam;
+    	register char *yy_cp = (yy_c_buf_p);
+
+	register YY_CHAR yy_c = 1;
+	if ( yy_accept[yy_current_state] )
+		{
+		(yy_last_accepting_state) = yy_current_state;
+		(yy_last_accepting_cpos) = yy_cp;
+		}
+	while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+		{
+		yy_current_state = (int) yy_def[yy_current_state];
+		if ( yy_current_state >= 84 )
+			yy_c = yy_meta[(unsigned int) yy_c];
+		}
+	yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c];
+	yy_is_jam = (yy_current_state == 83);
+
+	return yy_is_jam ? 0 : yy_current_state;
+}
+
+    static void yyunput (int c, register char * yy_bp )
+{
+	register char *yy_cp;
+    
+    yy_cp = (yy_c_buf_p);
+
+	/* undo effects of setting up convert_text */
+	*yy_cp = (yy_hold_char);
+
+	if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+		{ /* need to shift things up to make room */
+		/* +2 for EOB chars. */
+		register yy_size_t number_to_move = (yy_n_chars) + 2;
+		register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+					YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+		register char *source =
+				&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+		while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+			*--dest = *--source;
+
+		yy_cp += (int) (dest - source);
+		yy_bp += (int) (dest - source);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+			(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+		if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+			YY_FATAL_ERROR( "flex scanner push-back overflow" );
+		}
+
+	*--yy_cp = (char) c;
+
+	(yytext_ptr) = yy_bp;
+	(yy_hold_char) = *yy_cp;
+	(yy_c_buf_p) = yy_cp;
+}
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+    static int yyinput (void)
+#else
+    static int input  (void)
+#endif
+
+{
+	int c;
+    
+	*(yy_c_buf_p) = (yy_hold_char);
+
+	if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+		{
+		/* yy_c_buf_p now points to the character we want to return.
+		 * If this occurs *before* the EOB characters, then it's a
+		 * valid NUL; if not, then we've hit the end of the buffer.
+		 */
+		if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+			/* This was really a NUL. */
+			*(yy_c_buf_p) = '\0';
+
+		else
+			{ /* need more input */
+			yy_size_t offset = (yy_c_buf_p) - (yytext_ptr);
+			++(yy_c_buf_p);
+
+			switch ( yy_get_next_buffer(  ) )
+				{
+				case EOB_ACT_LAST_MATCH:
+					/* This happens because yy_g_n_b()
+					 * sees that we've accumulated a
+					 * token and flags that we need to
+					 * try matching the token before
+					 * proceeding.  But for input(),
+					 * there's no matching to consider.
+					 * So convert the EOB_ACT_LAST_MATCH
+					 * to EOB_ACT_END_OF_FILE.
+					 */
+
+					/* Reset buffer status. */
+					convert_restart(convert_in );
+
+					/*FALLTHROUGH*/
+
+				case EOB_ACT_END_OF_FILE:
+					{
+					if ( convert_wrap( ) )
+						return 0;
+
+					if ( ! (yy_did_buffer_switch_on_eof) )
+						YY_NEW_FILE;
+#ifdef __cplusplus
+					return yyinput();
+#else
+					return input();
+#endif
+					}
+
+				case EOB_ACT_CONTINUE_SCAN:
+					(yy_c_buf_p) = (yytext_ptr) + offset;
+					break;
+				}
+			}
+		}
+
+	c = *(unsigned char *) (yy_c_buf_p);	/* cast for 8-bit char's */
+	*(yy_c_buf_p) = '\0';	/* preserve convert_text */
+	(yy_hold_char) = *++(yy_c_buf_p);
+
+	return c;
+}
+#endif	/* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ * 
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+    void convert_restart  (FILE * input_file )
+{
+    
+	if ( ! YY_CURRENT_BUFFER ){
+        convert_ensure_buffer_stack ();
+		YY_CURRENT_BUFFER_LVALUE =
+            convert__create_buffer(convert_in,YY_BUF_SIZE );
+	}
+
+	convert__init_buffer(YY_CURRENT_BUFFER,input_file );
+	convert__load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ * 
+ */
+    void convert__switch_to_buffer  (YY_BUFFER_STATE  new_buffer )
+{
+    
+	/* TODO. We should be able to replace this entire function body
+	 * with
+	 *		convert_pop_buffer_state();
+	 *		convert_push_buffer_state(new_buffer);
+     */
+	convert_ensure_buffer_stack ();
+	if ( YY_CURRENT_BUFFER == new_buffer )
+		return;
+
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+	convert__load_buffer_state( );
+
+	/* We don't actually know whether we did this switch during
+	 * EOF (convert_wrap()) processing, but the only time this flag
+	 * is looked at is after convert_wrap() is called, so it's safe
+	 * to go ahead and always set it.
+	 */
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void convert__load_buffer_state  (void)
+{
+    	(yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+	(yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+	convert_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+	(yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ * 
+ * @return the allocated buffer state.
+ */
+    YY_BUFFER_STATE convert__create_buffer  (FILE * file, int  size )
+{
+	YY_BUFFER_STATE b;
+    
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
+
+	b->yy_buf_size = size;
+
+	/* yy_ch_buf has to be 2 characters longer than the size given because
+	 * we need to put in 2 end-of-buffer characters.
+	 */
+	b->yy_ch_buf = (char *) convert_alloc(b->yy_buf_size + 2  );
+	if ( ! b->yy_ch_buf )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" );
+
+	b->yy_is_our_buffer = 1;
+
+	convert__init_buffer(b,file );
+
+	return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with convert__create_buffer()
+ * 
+ */
+    void convert__delete_buffer (YY_BUFFER_STATE  b )
+{
+    
+	if ( ! b )
+		return;
+
+	if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+		YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+	if ( b->yy_is_our_buffer )
+		convert_free((void *) b->yy_ch_buf  );
+
+	convert_free((void *) b  );
+}
+
+#ifndef __cplusplus
+extern int isatty (int );
+#endif /* __cplusplus */
+    
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a convert_restart() or at EOF.
+ */
+    static void convert__init_buffer  (YY_BUFFER_STATE  b, FILE * file )
+
+{
+	int oerrno = errno;
+    
+	convert__flush_buffer(b );
+
+	b->yy_input_file = file;
+	b->yy_fill_buffer = 1;
+
+    /* If b is the current buffer, then convert__init_buffer was _probably_
+     * called from convert_restart() or through yy_get_next_buffer.
+     * In that case, we don't want to reset the lineno or column.
+     */
+    if (b != YY_CURRENT_BUFFER){
+        b->yy_bs_lineno = 1;
+        b->yy_bs_column = 0;
+    }
+
+        b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+    
+	errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ * 
+ */
+    void convert__flush_buffer (YY_BUFFER_STATE  b )
+{
+    	if ( ! b )
+		return;
+
+	b->yy_n_chars = 0;
+
+	/* We always need two end-of-buffer characters.  The first causes
+	 * a transition to the end-of-buffer state.  The second causes
+	 * a jam in that state.
+	 */
+	b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+	b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+	b->yy_buf_pos = &b->yy_ch_buf[0];
+
+	b->yy_at_bol = 1;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	if ( b == YY_CURRENT_BUFFER )
+		convert__load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ *  the current state. This function will allocate the stack
+ *  if necessary.
+ *  @param new_buffer The new state.
+ *  
+ */
+void convert_push_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+    	if (new_buffer == NULL)
+		return;
+
+	convert_ensure_buffer_stack();
+
+	/* This block is copied from convert__switch_to_buffer. */
+	if ( YY_CURRENT_BUFFER )
+		{
+		/* Flush out information for old buffer. */
+		*(yy_c_buf_p) = (yy_hold_char);
+		YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+		YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+		}
+
+	/* Only push if top exists. Otherwise, replace top. */
+	if (YY_CURRENT_BUFFER)
+		(yy_buffer_stack_top)++;
+	YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+	/* copied from convert__switch_to_buffer. */
+	convert__load_buffer_state( );
+	(yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ *  The next element becomes the new top.
+ *  
+ */
+void convert_pop_buffer_state (void)
+{
+    	if (!YY_CURRENT_BUFFER)
+		return;
+
+	convert__delete_buffer(YY_CURRENT_BUFFER );
+	YY_CURRENT_BUFFER_LVALUE = NULL;
+	if ((yy_buffer_stack_top) > 0)
+		--(yy_buffer_stack_top);
+
+	if (YY_CURRENT_BUFFER) {
+		convert__load_buffer_state( );
+		(yy_did_buffer_switch_on_eof) = 1;
+	}
+}
+
+/* Allocates the stack if it does not exist.
+ *  Guarantees space for at least one push.
+ */
+static void convert_ensure_buffer_stack (void)
+{
+	yy_size_t num_to_alloc;
+    
+	if (!(yy_buffer_stack)) {
+
+		/* First allocation is just for 2 elements, since we don't know if this
+		 * scanner will even need a stack. We use 2 instead of 1 to avoid an
+		 * immediate realloc on the next call.
+         */
+		num_to_alloc = 1;
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_alloc
+								(num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
+								  
+		memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+				
+		(yy_buffer_stack_max) = num_to_alloc;
+		(yy_buffer_stack_top) = 0;
+		return;
+	}
+
+	if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+		/* Increase the buffer to prepare for a possible push. */
+		int grow_size = 8 /* arbitrary grow size */;
+
+		num_to_alloc = (yy_buffer_stack_max) + grow_size;
+		(yy_buffer_stack) = (struct yy_buffer_state**)convert_realloc
+								((yy_buffer_stack),
+								num_to_alloc * sizeof(struct yy_buffer_state*)
+								);
+		if ( ! (yy_buffer_stack) )
+			YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" );
+
+		/* zero only the new slots.*/
+		memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+		(yy_buffer_stack_max) = num_to_alloc;
+	}
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ * 
+ * @return the newly allocated buffer state object. 
+ */
+YY_BUFFER_STATE convert__scan_buffer  (char * base, yy_size_t  size )
+{
+	YY_BUFFER_STATE b;
+    
+	if ( size < 2 ||
+	     base[size-2] != YY_END_OF_BUFFER_CHAR ||
+	     base[size-1] != YY_END_OF_BUFFER_CHAR )
+		/* They forgot to leave room for the EOB's. */
+		return 0;
+
+	b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state )  );
+	if ( ! b )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_buffer()" );
+
+	b->yy_buf_size = size - 2;	/* "- 2" to take care of EOB's */
+	b->yy_buf_pos = b->yy_ch_buf = base;
+	b->yy_is_our_buffer = 0;
+	b->yy_input_file = 0;
+	b->yy_n_chars = b->yy_buf_size;
+	b->yy_is_interactive = 0;
+	b->yy_at_bol = 1;
+	b->yy_fill_buffer = 0;
+	b->yy_buffer_status = YY_BUFFER_NEW;
+
+	convert__switch_to_buffer(b  );
+
+	return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to convert_lex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ * 
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ *       convert__scan_bytes() instead.
+ */
+YY_BUFFER_STATE convert__scan_string (yyconst char * yystr )
+{
+    
+	return convert__scan_bytes(yystr,strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to convert_lex() will
+ * scan from a @e copy of @a bytes.
+ * @param bytes the byte buffer to scan
+ * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * 
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE convert__scan_bytes  (yyconst char * yybytes, yy_size_t  _yybytes_len )
+{
+	YY_BUFFER_STATE b;
+	char *buf;
+	yy_size_t n, i;
+    
+	/* Get memory for full buffer, including space for trailing EOB's. */
+	n = _yybytes_len + 2;
+	buf = (char *) convert_alloc(n  );
+	if ( ! buf )
+		YY_FATAL_ERROR( "out of dynamic memory in convert__scan_bytes()" );
+
+	for ( i = 0; i < _yybytes_len; ++i )
+		buf[i] = yybytes[i];
+
+	buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+	b = convert__scan_buffer(buf,n );
+	if ( ! b )
+		YY_FATAL_ERROR( "bad buffer in convert__scan_bytes()" );
+
+	/* It's okay to grow etc. this buffer, and we should throw it
+	 * away when we're done.
+	 */
+	b->yy_is_our_buffer = 1;
+
+	return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yy_fatal_error (yyconst char* msg )
+{
+    	(void) fprintf( stderr, "%s\n", msg );
+	exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+	do \
+		{ \
+		/* Undo effects of setting up convert_text. */ \
+        int yyless_macro_arg = (n); \
+        YY_LESS_LINENO(yyless_macro_arg);\
+		convert_text[convert_leng] = (yy_hold_char); \
+		(yy_c_buf_p) = convert_text + yyless_macro_arg; \
+		(yy_hold_char) = *(yy_c_buf_p); \
+		*(yy_c_buf_p) = '\0'; \
+		convert_leng = yyless_macro_arg; \
+		} \
+	while ( 0 )
+
+/* Accessor  methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ * 
+ */
+int convert_get_lineno  (void)
+{
+        
+    return convert_lineno;
+}
+
+/** Get the input stream.
+ * 
+ */
+FILE *convert_get_in  (void)
+{
+        return convert_in;
+}
+
+/** Get the output stream.
+ * 
+ */
+FILE *convert_get_out  (void)
+{
+        return convert_out;
+}
+
+/** Get the length of the current token.
+ * 
+ */
+yy_size_t convert_get_leng  (void)
+{
+        return convert_leng;
+}
+
+/** Get the current token.
+ * 
+ */
+
+char *convert_get_text  (void)
+{
+        return convert_text;
+}
+
+/** Set the current line number.
+ * @param line_number
+ * 
+ */
+void convert_set_lineno (int  line_number )
+{
+    
+    convert_lineno = line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param in_str A readable stream.
+ * 
+ * @see convert__switch_to_buffer
+ */
+void convert_set_in (FILE *  in_str )
+{
+        convert_in = in_str ;
+}
+
+void convert_set_out (FILE *  out_str )
+{
+        convert_out = out_str ;
+}
+
+int convert_get_debug  (void)
+{
+        return convert__flex_debug;
+}
+
+void convert_set_debug (int  bdebug )
+{
+        convert__flex_debug = bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+        /* Initialization is the same as for the non-reentrant scanner.
+     * This function is called from convert_lex_destroy(), so don't allocate here.
+     */
+
+    (yy_buffer_stack) = 0;
+    (yy_buffer_stack_top) = 0;
+    (yy_buffer_stack_max) = 0;
+    (yy_c_buf_p) = (char *) 0;
+    (yy_init) = 0;
+    (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+    convert_in = stdin;
+    convert_out = stdout;
+#else
+    convert_in = (FILE *) 0;
+    convert_out = (FILE *) 0;
+#endif
+
+    /* For future reference: Set errno on error, since we are called by
+     * convert_lex_init()
+     */
+    return 0;
+}
+
+/* convert_lex_destroy is for both reentrant and non-reentrant scanners. */
+int convert_lex_destroy  (void)
+{
+    
+    /* Pop the buffer stack, destroying each element. */
+	while(YY_CURRENT_BUFFER){
+		convert__delete_buffer(YY_CURRENT_BUFFER  );
+		YY_CURRENT_BUFFER_LVALUE = NULL;
+		convert_pop_buffer_state();
+	}
+
+	/* Destroy the stack itself. */
+	convert_free((yy_buffer_stack) );
+	(yy_buffer_stack) = NULL;
+
+    /* Reset the globals. This is important in a non-reentrant scanner so the next time
+     * convert_lex() is called, initialization will occur. */
+    yy_init_globals( );
+
+    return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, yyconst char * s2, int n )
+{
+	register int i;
+	for ( i = 0; i < n; ++i )
+		s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (yyconst char * s )
+{
+	register int n;
+	for ( n = 0; s[n]; ++n )
+		;
+
+	return n;
+}
+#endif
+
+void *convert_alloc (yy_size_t  size )
+{
+	return (void *) malloc( size );
+}
+
+void *convert_realloc  (void * ptr, yy_size_t  size )
+{
+	/* The cast to (char *) in the following accommodates both
+	 * implementations that use char* generic pointers, and those
+	 * that use void* generic pointers.  It works with the latter
+	 * because both ANSI C and C++ allow castless assignment from
+	 * any pointer type to void*, and deal with argument conversions
+	 * as though doing an assignment.
+	 */
+	return (void *) realloc( (char *) ptr, size );
+}
+
+void convert_free (void * ptr )
+{
+	free( (char *) ptr );	/* see convert_realloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 69 "convert.lex"
+
+
+
Index: vendors/AGRIF/LIB/run
===================================================================
--- vendors/AGRIF/LIB/run	(revision 9621)
+++ vendors/AGRIF/LIB/run	(revision 9621)
@@ -0,0 +1,2 @@
+make -f Makefile.lex clean
+make -f Makefile.lex
Index: vendors/AGRIF/LIB/toamr.c
===================================================================
--- vendors/AGRIF/LIB/toamr.c	(revision 9621)
+++ vendors/AGRIF/LIB/toamr.c	(revision 9621)
@@ -0,0 +1,962 @@
+/******************************************************************************/
+/*                                                                            */
+/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
+/*                                                                            */
+/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
+/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
+/* This software is governed by the CeCILL-C license under French law and     */
+/* abiding by the rules of distribution of free software.  You can  use,      */
+/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
+/* license as circulated by CEA, CNRS and INRIA at the following URL          */
+/* "http://www.cecill.info".                                                  */
+/*                                                                            */
+/* As a counterpart to the access to the source code and  rights to copy,     */
+/* modify and redistribute granted by the license, users are provided only    */
+/* with a limited warranty  and the software's author,  the holder of the     */
+/* economic rights,  and the successive licensors  have only  limited         */
+/* liability.                                                                 */
+/*                                                                            */
+/* In this respect, the user's attention is drawn to the risks associated     */
+/* with loading,  using,  modifying and/or developing or reproducing the      */
+/* software by the user in light of its specific status of free software,     */
+/* that may mean  that it is complicated to manipulate,  and  that  also      */
+/* therefore means  that it is reserved for developers  and  experienced      */
+/* professionals having in-depth computer knowledge. Users are therefore      */
+/* encouraged to load and test the software's suitability as regards their    */
+/* requirements in conditions enabling the security of their systems and/or   */
+/* data to be ensured and,  more generally, to use and operate it in the      */
+/* same conditions as regards security.                                       */
+/*                                                                            */
+/* The fact that you are presently reading this means that you have had       */
+/* knowledge of the CeCILL-C license and that you accept its terms.           */
+/******************************************************************************/
+/* version 1.7                                                                */
+/******************************************************************************/
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "decl.h"
+
+const char * tabvarsname(const variable *var)
+{
+    static char * tname[5] = {
+        "tabvars",      // v_catvar == 0
+        "tabvars_c",    // v_catvar == 1
+        "tabvars_r",    // v_catvar == 2
+        "tabvars_l",    // v_catvar == 3
+        "tabvars_i"     // v_catvar == 4
+    };
+    return tname[var->v_catvar];    // v_catvar should never be ouside the range [0:4].
+}
+
+/******************************************************************************/
+/*                        variablecurgridtabvars                              */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  ----------->  Agrif_Curgrid % tabvars (i)                                 */
+/*                                                                            */
+/******************************************************************************/
+const char * variablecurgridtabvars(int which_grid)
+{
+    static char * varname[4] = {
+        " Agrif_%s(%d)",                // which_grid == 0
+        " Agrif_%s(%d) %% parent_var",  // which_grid == 1
+        " Agrif_Mygrid %% %s(%d)",      // which_grid == 2
+        " Agrif_Curgrid %% %s(%d)",     // which_grid == 3
+    };
+
+    return varname[which_grid];
+}
+
+void WARNING_CharSize(const variable *var)
+{
+    if ( var->v_nbdim == 0 )
+    {
+        if ( convert2int(var->v_dimchar) > 2400 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 2400. You must change         \n");
+            printf("   the dimension of carray0                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 161. Replace 2400 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),1);
+    }
+    else if ( var->v_nbdim == 1 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray1                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 162. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),2);
+    }
+    else if ( var->v_nbdim == 2 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray2                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 163. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),3);
+    }
+    else if ( var->v_nbdim == 3 )
+    {
+        if ( convert2int(var->v_dimchar) > 200 )
+        {
+            printf("WARNING : The dimension of the character  %s   \n", var->v_nomvar);
+            printf("   is upper than 200. You must change          \n");
+            printf("   the dimension of carray3                    \n");
+            printf("   in the file AGRIF/AGRIF_FILES/modtypes.F90  \n");
+            printf("   line 164. Replace 200 with %d.              \n", convert2int(var->v_dimchar)+100);
+        }
+        Save_Length_int(convert2int(var->v_dimchar),4);
+    }
+}
+/******************************************************************************/
+/*                           vargridnametabvars                               */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/*  if iorindice == 0 ----------->  Agrif_Gr % tabvars (i) % array1           */
+/*                                                                            */
+/*  if iorindice == 1 ----------->  Agrif_Gr % tabvars (12) % array1          */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridnametabvars (const variable * var, int iorindice)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars);
+    else                  sprintf(tname_1, "Agrif_Gr %% %s(i)",  tabvarsname(var));
+
+    if (!strcasecmp(var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d",  var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "integer"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "logical"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "character"))
+    {
+        WARNING_CharSize(var);
+        sprintf (tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                           vargridcurgridtabvars                            */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/* if which_grid == 0 -->  Agrif_Curgrid % tabvars (i) % array1               */
+/*                                                                            */
+/* if which_grid == 1 -->  Agrif_tabvars (i) % parent_var % array1            */
+/*                                                                            */
+/* if which_grid == 2 -->  Agrif_Gr % tabvars (i) % array1                    */
+/*                                                                            */
+/******************************************************************************/
+const char *vargridcurgridtabvars(const variable *var, int which_grid)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    if (!strcasecmp(var->v_typevar,"type"))
+    {
+        sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar);
+    }
+    else
+    {
+        sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars);
+
+        if (!strcasecmp(var->v_typevar, "REAL"))
+        {
+            if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+            else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+            else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "INTEGER"))
+        {
+            sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+        {
+            sprintf(tname_2, "%% larray%d", var->v_nbdim);
+        }
+        else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+        {
+            WARNING_CharSize(var);
+            sprintf(tname_2, "%% carray%d", var->v_nbdim);
+        }
+        strcat(tname_1, tname_2);
+    }
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                  vargridcurgridtabvarswithoutAgrif_Gr                      */
+/******************************************************************************/
+/* This subroutine is used to create the string                               */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var)
+{
+    static char tname_1[LONG_C];
+    static char tname_2[LONG_C];
+
+    sprintf(tname_1, "(%d)", var->v_indicetabvars);
+
+    if (!strcasecmp (var->v_typevar, "REAL"))
+    {
+        if      ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim);
+        else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim);
+        else                                                sprintf(tname_2, "%% array%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "INTEGER"))
+    {
+        sprintf(tname_2, "%% iarray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
+    {
+        sprintf(tname_2, "%% larray%d", var->v_nbdim);
+    }
+    else if (!strcasecmp(var->v_typevar, "CHARACTER"))
+    {
+        WARNING_CharSize(var);
+        sprintf(tname_2, "%% carray%d", var->v_nbdim);
+    }
+
+    strcat(tname_1, tname_2);
+    Save_Length(tname_1, 46);
+
+    return tname_1;
+}
+
+/******************************************************************************/
+/*                               vargridparam                                 */
+/******************************************************************************/
+/* This subroutine is used to create the string which contains                */
+/* dimension list                                                             */
+/******************************************************************************/
+/*                                                                            */
+/*  DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj"                            */
+/*                                                                            */
+/******************************************************************************/
+const char * vargridparam(const variable *var)
+{
+    typedim dim;
+    listdim *newdim;
+    char newname[LONG_M];
+
+    newdim = var->v_dimension;
+    if (!newdim) return "";
+
+    strcpy (tmpvargridname, "(");
+    while (newdim)
+    {
+        dim = newdim->dim;
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        strcat(tmpvargridname, " : ");
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var));
+        strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var));
+        strcat(tmpvargridname, newname);
+        newdim = newdim->suiv;
+        if (newdim) strcat(tmpvargridname, ",");
+    }
+    strcat(tmpvargridname, ")\0");
+    Save_Length(tmpvargridname,40);
+    return tmpvargridname;
+}
+
+/******************************************************************************/
+/*                        write_probdimagrif_file                             */
+/******************************************************************************/
+/* This subroutine is used to create the file probdim_agrif.h                 */
+/******************************************************************************/
+/*                                                                            */
+/*               probdim_agrif.h                                              */
+/*                                                                            */
+/*               Agrif_probdim = <number>                                     */
+/*                                                                            */
+/******************************************************************************/
+void write_probdimagrif_file()
+{
+  FILE *probdim;
+  char ligne[LONG_M];
+
+  probdim = open_for_write("probdim_agrif.h");
+  sprintf (ligne, "Agrif_Probdim = %d", dimprob);
+  tofich (probdim, ligne,1);
+  fclose (probdim);
+}
+
+/******************************************************************************/
+/*                             write_keysagrif_file                           */
+/******************************************************************************/
+/* This subroutine is used to create the file keys_agrif.h                    */
+/******************************************************************************/
+/*                                                                            */
+/*               keys_agrif.h                                                 */
+/*                                                                            */
+/*               AGRIF_USE_FIXED_GRIDS = 0                                    */
+/*               AGRIF_USE_ONLY_FIXED_GRIDS = 0                               */
+/*               AGRIF_USE_(ONLY)_FIXED_GRIDS = 1                             */
+/*                                                                            */
+/******************************************************************************/
+void write_keysagrif_file()
+{
+  FILE *keys;
+
+  keys = open_for_write("keys_agrif.h");
+  fprintf(keys,"      AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids);
+  fprintf(keys,"      AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids);
+  fclose(keys);
+}
+
+/******************************************************************************/
+/*                      write_modtypeagrif_file                               */
+/******************************************************************************/
+/* This subroutine is used to create the file typedata                        */
+/******************************************************************************/
+/*                                                                            */
+/*               modtype_agrif.h                                              */
+/*                                                                            */
+/*               Agrif_NbVariables =                                          */
+/*                                                                            */
+/******************************************************************************/
+void write_modtypeagrif_file()
+{
+  char ligne[LONG_M];
+  FILE *typedata;
+  int i;
+
+  typedata = open_for_write("modtype_agrif.h");
+  /* AGRIF_NbVariables : number of variables                                  */
+  for (i=0;i<NB_CAT_VARIABLES;i++)
+   {
+    sprintf (ligne, "Agrif_NbVariables(%d) = %d",i,indicemaxtabvars[i]);
+    tofich(typedata,ligne,1);
+   }
+  fclose (typedata);
+}
+
+/******************************************************************************/
+/*                   write_createvarnameagrif_file                            */
+/******************************************************************************/
+/* This subroutine is used to create the file  createvarname                  */
+/******************************************************************************/
+/*                                                                            */
+/*    Agrif_Gr % tabvars (i) % namevar = "variable"                           */
+/*                                                                            */
+/******************************************************************************/
+void write_createvarnameagrif_file(variable *v,FILE *createvarname, int *InitEmpty)
+{
+    char ligne[LONG_M];
+
+    *InitEmpty = 0 ;
+    sprintf(ligne, "Agrif_Gr %% %s(%d) %% namevar = \"%s\"",tabvarsname(v),v->v_indicetabvars,v->v_nomvar);
+    tofich(createvarname,ligne,1);
+}
+
+/******************************************************************************/
+/*                        write_Setnumberofcells_file                         */
+/******************************************************************************/
+/* This subroutine is used to create the file  setnumberofcells               */
+/******************************************************************************/
+/*                                                                            */
+/*              Agrif_Gr % n(i) = nbmailles                                   */
+/*                                                                            */
+/******************************************************************************/
+void write_Setnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *setnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )  return;
+
+    setnumberofcells = open_for_write("SetNumberofcells.h");
+
+    if ( onlyfixedgrids == 1 )
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0");
+    else
+        strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0");
+
+    sprintf(ligne, cformat, 1, IndicenbmaillesX);
+    tofich(setnumberofcells, ligne, 1);
+
+    if ( dimprob > 1 )
+    {
+        sprintf(ligne, cformat, 2, IndicenbmaillesY);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    if ( dimprob > 2 )
+    {
+        sprintf(ligne, cformat, 3, IndicenbmaillesZ);
+        tofich(setnumberofcells, ligne, 1);
+    }
+    fclose(setnumberofcells);
+}
+
+/******************************************************************************/
+/*                       write_Getnumberofcells_file                          */
+/******************************************************************************/
+/* This subroutine is used to create the file  getnumberofcells               */
+/******************************************************************************/
+/*                                                                            */
+/*              nbmailles = Agrif_Gr % n(i)                                   */
+/*                                                                            */
+/******************************************************************************/
+void write_Getnumberofcells_file()
+{
+    char ligne[LONG_VNAME];
+    char cformat[LONG_VNAME];
+    FILE *getnumberofcells;
+
+    if ( IndicenbmaillesX == 0 )    return;
+
+    strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)");
+
+    getnumberofcells = open_for_write("GetNumberofcells.h");
+
+    sprintf(ligne, cformat, IndicenbmaillesX, 1);
+    tofich(getnumberofcells, ligne, 1);
+
+    if (dimprob > 1)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesY, 2);
+        tofich(getnumberofcells, ligne,1);
+    }
+    if (dimprob > 2)
+    {
+        sprintf(ligne, cformat, IndicenbmaillesZ, 3);
+        tofich(getnumberofcells, ligne,1);
+    }
+    fclose(getnumberofcells);
+}
+
+
+/******************************************************************************/
+/*                      write_initialisationsagrif_file                       */
+/******************************************************************************/
+/* This subroutine is used to create the file initproc                        */
+/******************************************************************************/
+/*                                                                            */
+/*              ! variable                                                    */
+/*              Agrif_Gr % tabvars(i) % nbdim = 1                             */
+/*                                                                            */
+/******************************************************************************/
+void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty)
+{
+    char ligne[LONG_M];
+
+    if ( v->v_nbdim != 0 )
+    {
+        *VarnameEmpty = 0 ;
+        sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim);
+        tofich (initproc, ligne,1);
+    }
+}
+
+
+void Write_Alloc_Agrif_Files()
+{
+   listnom *parcours;
+   FILE *alloccalls;
+   FILE *AllocUSE;
+
+   AllocUSE= open_for_write("include_use_Alloc_agrif.h");
+   alloccalls = open_for_write("allocations_calls_agrif.h");
+
+   parcours = List_Subroutine_For_Alloc;
+   while ( parcours )
+   {
+      fprintf(AllocUSE,"      use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom );
+      fprintf (alloccalls,"      call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom );
+      parcours = parcours -> suiv;
+   }
+
+   fclose (AllocUSE);
+   fclose (alloccalls);
+}
+
+int IndiceInlist(int indic, listindice *listin)
+{
+   listindice *parcoursindic;
+   int out;
+
+   out = 0 ;
+
+   parcoursindic = listin;
+   while ( parcoursindic && out == 0 )
+   {
+      if ( parcoursindic->i_indice == indic ) out = 1;
+      else parcoursindic = parcoursindic -> suiv;
+   }
+
+   return out;
+}
+
+void write_allocation_Common_0()
+{
+    listnom *parcours_nom;
+    listnom *neededparameter;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    FILE *paramtoamr;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    listindice **list_indic;
+    listindice *parcoursindic;
+    int i;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfCommon;
+    ValeurMax = 2;
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+            fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom);
+
+            sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom);
+            paramtoamr = open_for_write(ligne);
+            neededparameter = (listnom *) NULL;
+            list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *));
+
+//             shouldincludempif = 1 ;
+            parcours = List_Common_Var;
+            while ( parcours )
+            {
+                if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) &&
+                    IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        i = parcours->var->v_indicetabvars;
+                                        do
+                                        {
+                                            parcoursindic =  (listindice *)calloc(1,sizeof(listindice));
+                                            parcoursindic -> i_indice = i;
+                                            parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                            list_indic[parcours->var->v_catvar] = parcoursindic;
+                                            i = i + 1;
+                                        } while ( i <= parcours->var->v_indicetabvars+compteur );
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        parcoursindic =  (listindice *) calloc(1,sizeof(listindice));
+                                        parcoursindic -> i_indice = parcours->var->v_indicetabvars;
+                                        parcoursindic -> suiv = list_indic[parcours->var->v_catvar];
+                                        list_indic[parcours->var->v_catvar] = parcoursindic;
+                                    }
+                                    neededparameter = writedeclarationintoamr(List_Parameter_Var,
+                                                        paramtoamr,v,parcours_nom->o_nom,neededparameter,v->v_commonname);
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+
+                                if (v->v_nbdim == 0)
+                                {
+                                    strcpy(ligne2,initialvalue);
+                                }
+                                else
+                                {
+                                    sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0));
+                                }
+                                strcat(ligne,ligne2);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
+            }
+            /* Close the file Alloc_agrif                                        */
+            fclose(allocationagrif);
+            fclose(paramtoamr);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
+}
+
+void write_allocation_Global_0()
+{
+    listnom *parcours_nom;
+    listvar *parcours;
+    listvar *parcoursprec;
+    listvar *parcours1;
+    FILE *allocationagrif;
+    char ligne[LONG_M];
+    char ligne2[LONG_M];
+    variable *v;
+    int IndiceMax;
+    int IndiceMin;
+    int compteur;
+    int out;
+    int indiceprec;
+    int ValeurMax;
+    char initialvalue[LONG_M];
+    int typeiswritten ;
+
+    parcoursprec = (listvar *) NULL;
+    parcours_nom = List_NameOfModule;
+    ValeurMax = 2;
+
+    while ( parcours_nom  )
+    {
+        if ( parcours_nom->o_val == 1 )
+        {
+            IndiceMax = 0;
+            IndiceMin = indicemaxtabvars[0];
+            /* Open the file to create the Alloc_agrif subroutine                */
+            sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom);
+            allocationagrif = open_for_write(ligne);
+
+//             if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+//             {
+//                 /* add the call to initworkspace         */
+//                 tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1);
+//                 tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"else",1);
+//                 tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0);
+//                 tofich(allocationagrif,"endif",1);
+//                 tofich(allocationagrif,"call Agrif_InitWorkspace",1);
+//             }
+
+            typeiswritten = 0;
+            parcours = List_Global_Var;
+            while ( parcours )
+            {
+                if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
+                       parcours->var->v_VariableIsParameter == 0                  &&
+                       parcours->var->v_notgrid == 0  )
+                {
+                    v = parcours->var;
+                    IndiceMax = 0;
+                    IndiceMin = indicemaxtabvars[v->v_catvar];
+                    /* body of the file */
+                    if ( !strcasecmp(v->v_commoninfile,cur_filename) )
+                    {
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0));
+                            tofich(allocationagrif,ligne,1);
+                        }
+                        if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) )
+                        {
+                            /*                ALLOCATION                                          */
+                            if ( v->v_dimension != 0 )
+                            {
+                                if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax )
+                                {
+                                    parcours1 = parcours;
+                                    compteur = -1;
+                                    out = 0;
+                                    indiceprec = parcours->var->v_indicetabvars -1 ;
+                                    while ( parcours1 && out == 0
+                                        && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension)
+                                        && !strcasecmp(parcours->var->v_typevar,            parcours1->var->v_typevar)
+                                        && (parcours1->var->v_indicetabvars == indiceprec+1) )
+                                    {
+                                        if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) ||
+                                             !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) )
+                                        {
+                                            compteur = compteur +1 ;
+                                            indiceprec = parcours1->var->v_indicetabvars;
+                                            parcoursprec = parcours1;
+                                            parcours1 = parcours1->suiv;
+                                        }
+                                        else out = 1;
+                                    }
+                                    sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar);
+                                    tofich(allocationagrif,ligne,1);
+                                    if ( compteur > ValeurMax )
+                                    {
+                                        sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars,
+                                                                      parcours->var->v_indicetabvars+compteur);
+                                        tofich(allocationagrif,ligne,1);
+                                        IndiceMin = parcours->var->v_indicetabvars;
+                                        IndiceMax = parcours->var->v_indicetabvars+compteur;
+                                        sprintf(ligne,"    allocate(%s", vargridnametabvars(v,1));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                        tofich(allocationagrif,"enddo",1);
+                                        parcours = parcoursprec;
+                                    }
+                                    else
+                                    {
+                                        sprintf(ligne,"allocate(%s", vargridnametabvars(v,0));
+                                        sprintf(ligne2,"%s)", vargridparam(v));
+                                        strcat(ligne,ligne2);
+                                        tofich(allocationagrif,ligne,1);
+                                    }
+                                }
+                            } /* end of the allocation part                                       */
+                            /*                INITIALISATION                                      */
+                            if ( strcasecmp(v->v_initialvalue,"") )
+                            {
+                                strcpy(ligne, vargridnametabvars(v,0));
+                                /* We should modify the initialvalue in the case of variable has been defined with others variables */
+                                strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Global_Var));
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_Common_Var));
+                                }
+                                if ( !strcasecmp(initialvalue,v->v_initialvalue) )
+                                {
+                                    strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(v->v_initialvalue,List_ModuleUsed_Var));
+                                }
+                                strcat (ligne," = ");
+                                strcat (ligne,initialvalue);
+                                Save_Length(ligne,48);
+                                tofich(allocationagrif,ligne,1);
+                            }
+                        }
+                        /* Case of structure types */
+                        if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") )
+                        {
+                            sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            sprintf(ligne,"    allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename);
+                            tofich(allocationagrif, ligne, 1);
+                            tofich(allocationagrif, "endif", 1);
+                            typeiswritten = 1;
+                        }
+                        if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) )
+                        {
+                            tofich(allocationagrif,"endif",1);
+                        }
+                    }
+                }
+                parcours = parcours -> suiv;
+            }
+            if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 )
+            {
+                fprintf(allocationagrif, "      if ( .not.Agrif_Root() ) then\n");
+                fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      else\n");
+                fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n");
+                fprintf(allocationagrif, "      endif\n");
+                fprintf(allocationagrif, "      call Agrif_InitWorkspace\n");
+            }
+            fclose(allocationagrif);
+        }
+        parcours_nom = parcours_nom -> suiv;
+    }
+}
+
+/******************************************************************************/
+/*                           creefichieramr                                   */
+/******************************************************************************/
+/* This subroutine is the main one to create AGRIF_INC files                  */
+/******************************************************************************/
+/*                                                                            */
+/******************************************************************************/
+void creefichieramr ()
+{
+    listvar *newvar;
+    variable *v;
+    int erreur;
+    char filefich[LONG_M];
+
+    int InitEmpty;
+    int VarnameEmpty;
+    int donotwrite;
+
+    FILE *initproc;
+    FILE *initglobal;
+    FILE *createvarname;
+    FILE *createvarnameglobal;
+
+    if ( todebug == 1 ) printf("Enter in creefichieramr\n");
+
+    sprintf(filefich, "cd %s", include_dir);
+    erreur = system (filefich);
+    if (erreur)
+    {
+        sprintf(filefich, "mkdir -p %s", include_dir);
+        system(filefich);
+        printf("%s: Directory created\n", include_dir);
+    }
+
+/******************************************************************************/
+/******************** Creation of AGRIF_INC files *****************************/
+/******************************************************************************/
+
+    if ( todebug == 1 )
+    {
+        const char *NameTampon = "toto";
+        sprintf(filefich,"initialisations_agrif_%s.h", NameTampon);
+        initproc = open_for_write(filefich);
+
+        sprintf(filefich,"createvarname_agrif_%s.h", NameTampon);
+        createvarname = open_for_write(filefich);
+
+        InitEmpty = 1 ;
+        VarnameEmpty = 1 ;
+
+        newvar = List_Global_Var;
+        while ( newvar )
+        {
+            donotwrite = 0;
+            v = newvar->var;
+
+            if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 )
+            {
+                write_createvarnameagrif_file(v,createvarname,&VarnameEmpty);
+                write_initialisationsagrif_file(v,initproc,&InitEmpty);
+            }
+            newvar = newvar->suiv;
+        }
+        fclose (createvarname);
+        fclose (initproc);
+
+        if ( is_dependfile_created(curmodulename) == 0 )
+        {
+            if ( InitEmpty != 1  )
+            {
+                initglobal = open_for_append("initialisations_agrif.h");
+                fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon);
+                fclose(initglobal);
+            }
+            if ( VarnameEmpty != 1 )
+            {
+                createvarnameglobal= open_for_append("createvarname_agrif.h");
+                fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon);
+                fclose(createvarnameglobal);
+            }
+        }
+    }
+    write_allocation_Common_0();
+    write_allocation_Global_0();
+
+    Write_Alloc_Agrif_Files();
+    write_probdimagrif_file();
+    write_keysagrif_file();
+    write_modtypeagrif_file();
+
+    if ( NbMailleXDefined == 1 )
+    {
+        write_Setnumberofcells_file();
+        write_Getnumberofcells_file();
+    }
+
+    if ( todebug == 1 ) printf("Out of creefichieramr\n");
+}
Index: vendors/AGRIF/agrif_oce.in
===================================================================
--- vendors/AGRIF/agrif_oce.in	(revision 9621)
+++ vendors/AGRIF/agrif_oce.in	(revision 9621)
@@ -0,0 +1,12 @@
+% Number of cells in each direction %
+ 2D nbcellsx,nbcellsy;
+% Name of the common file : an include file (paramfile) OR a module (parammodule) %  
+ parammodule par_oce ;
+
+USE ONLY_FIXED_GRIDS;
+
+% Variables which are not grid dependent %
+% notgriddep :: name of the variable; %
+notgriddep :: nstop;
+
+%USE DEBUG;%
Index: vendors/AGRIF/nemo_mpi.h
===================================================================
--- vendors/AGRIF/nemo_mpi.h	(revision 9621)
+++ vendors/AGRIF/nemo_mpi.h	(revision 9621)
@@ -0,0 +1,3 @@
+#if defined key_mpp_mpi
+#define AGRIF_MPI
+#endif
Index: vendors/FCM/COPYRIGHT.txt
===================================================================
--- vendors/FCM/COPYRIGHT.txt	(revision 9621)
+++ vendors/FCM/COPYRIGHT.txt	(revision 9621)
@@ -0,0 +1,109 @@
+!------------------------------------------------------------------------------!
+!              Flexible Configuration Management Software License              !
+!                                                                              !
+!     Please read this Software Licence as you will be bound by its terms      !
+!                           if you use the Software                            !
+!------------------------------------------------------------------------------!
+
+The Licensor:
+-------------
+
+The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom
+--------------------------------------------------------------------------------
+
+1. Licence.
+-----------
+
+The Met Office grants you a non-exclusive, royalty free; world-wide,
+transferable Licence to use, modify, copy and distribute the Flexible
+Configuration Management software ("the software") accompanying this License
+providing:
+
+a. you undertake to provide to the Met Office a copy of any modifications made
+   by you on the same terms contained within this licence agreement;
+
+b. modified files carry prominent notices stating that you changed the files
+   and the date of change;
+
+c. distribution of original or modified files is made free of charge under the
+   terms of this Licence;
+
+d. the appropriate copyright notices, the above copyright notice and a
+   disclaimer of warranty is included with the distribution.
+
+2. Ownership.
+-------------
+
+The Flexible Configuration Management software is Crown copyright and is
+reproduced with the permission of Met Office under delegated authority from
+the Controller of HMSO. The software and documentation are provided to you to
+allow you to exercise your rights under this License, which is granted to you.
+
+3. Duration.
+------------
+
+This license will remain in effect until terminated.
+ 
+4. Termination.
+---------------
+
+You may terminate this license at any time by removing all copies of the
+software from your system.  This License will terminate immediately without
+notice from us if you fail to comply with any of the provisions of this
+License or in the event of your breaching the terms of this licence you are
+given notice that the license has been terminated.  Upon termination you will
+delete all copies of the software and any related documentation.
+
+5. Disclaimer of Warranty.
+--------------------------
+
+a. THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+   INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+   AND FIT FOR THE PURPOSE.  NEITHER DOES THE MET OFFICE MAKE ANY
+   REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+   PLATFORMS.
+
+b. In no event does the Met Office warrant that the software or related
+   documentation will satisfy your requirements, that the software and
+   documentation will be without errors or defects or that the operation of
+   the software will be uninterrupted.
+
+c. IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES, INCLUDING
+   BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE SOFTWARE
+   OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF THE MET
+   OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+6. General Provisions.
+----------------------
+
+a. You will not do anything, relating to this software that will bring the Met
+   Office into disrepute.
+
+b. You will not use the name of the Met Office or any other contributor to
+   endorse or promote any products derived from the software without the
+   written permission of the Met Office.
+
+7. Acknowledgements.
+--------------------
+
+The logic to extract the calling interfaces of top level subroutines and
+functions from a Fortran source file is adapted from a script developed at
+ECMWF and is provided by kind permission of ECMWF under the same terms of this
+Licence.
+
+8. Entire Agreement.
+--------------------
+
+This License constitutes the entire agreement between us with respect to your
+rights or warranties for using the software and related documentation.  If any
+provision of this agreement is determined to be invalid or unenforceable the
+remaining provisions shall continue in full force.
+
+9. Governing Law.
+-----------------
+
+This Agreement is governed by and construed in accordance with the Laws of
+England.
+
+--------------------------------------------------------------------------------
+                                              © British Crown copyright 2006-10.
Index: vendors/FCM/LICENSE.html
===================================================================
--- vendors/FCM/LICENSE.html	(revision 9621)
+++ vendors/FCM/LICENSE.html	(revision 9621)
@@ -0,0 +1,154 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+  <title>Flexible Configuration Management Software License</title>
+  <meta name="copyright" content="&copy; British Crown Copyright" />
+  <meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<style type="text/css">
+/*<![CDATA[*/
+  <!--
+  body {
+    font: normal normal 10pt Arial, sans-serif;
+  }
+
+  h1 {
+    text-align: center;
+    text-decoration: underline;
+    font: normal bold 14pt Arial, sans-serif;
+  }
+
+  h2 {
+    text-align: left;
+    text-decoration: none;
+    font: normal normal 14pt Arial, sans-serif;
+  }
+
+  h3 {
+    text-align: left;
+    text-decoration: none;
+    font: normal bold 10pt Arial, sans-serif;
+  }
+
+  address {
+    text-align: right;
+    font: normal bold 11pt Arial, sans-serif;
+  }
+
+  ol li {
+    list-style: lower-alpha;
+  }
+  //-->
+/*]]>*/
+</style>
+</head>
+
+<body>
+  <h1>Flexible Configuration Management Software License</h1>
+
+  <h1>Please read this Software Licence as you will be bound by its terms if
+  you use the Software</h1>
+
+  <h2>The Licensor:</h2>
+
+  <h2>The Met Office of FitzRoy Road, Exeter EX1 3PB, United Kingdom</h2>
+
+  <h3>1. Licence.</h3>
+
+  <p>The Met Office grants you a non-exclusive, royalty free; world-wide,
+  transferable Licence to use, modify, copy and distribute the Flexible
+  Configuration Management software ("the software") accompanying this License
+  providing:</p>
+
+  <ol>
+    <li>you undertake to provide to the Met Office a copy of any modifications
+    made by you on the same terms contained within this licence agreement;</li>
+
+    <li>modified files carry prominent notices stating that you changed the
+    files and the date of change;</li>
+
+    <li>distribution of original or modified files is made free of charge under
+    the terms of this Licence;</li>
+
+    <li>the appropriate copyright notices, the above copyright notice and a
+    disclaimer of warranty is included with the distribution.</li>
+  </ol>
+
+  <h3>2. Ownership.</h3>
+
+  <p>The Flexible Configuration Management software is Crown copyright and is
+  reproduced with the permission of Met Office under delegated authority from
+  the Controller of HMSO. The software and documentation are provided to you to
+  allow you to exercise your rights under this License, which is granted to
+  you.</p>
+
+  <h3>3. Duration.</h3>
+
+  <p>This license will remain in effect until terminated.</p>
+
+  <h3>4. Termination.</h3>
+
+  <p>You may terminate this license at any time by removing all copies of the
+  software from your system. This License will terminate immediately without
+  notice from us if you fail to comply with any of the provisions of this
+  License or in the event of your breaching the terms of this licence you are
+  given notice that the license has been terminated. Upon termination you will
+  delete all copies of the software and any related documentation.</p>
+
+  <h3>5. Disclaimer of Warranty.</h3>
+
+  <ol>
+    <li>THE MET OFFICE DISCLAIMS ALL WARRANTIES, REPRESENTATIONS AND PROMISES,
+    INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF SATISFACTORY QUALITY
+    AND FIT FOR THE PURPOSE. NEITHER DOES THE MET OFFICE MAKE ANY
+    REPRESENTATIONS AS TO COMPATABILITY WITH YOUR OPERATING SYSTEMS AND
+    PLATFORMS.</li>
+
+    <li>In no event does the Met Office warrant that the software or related
+    documentation will satisfy your requirements, that the software and
+    documentation will be without errors or defects or that the operation of
+    the software will be uninterrupted.</li>
+
+    <li>IN NO EVENT WILL THE MET OFFICE BE LIABLE FOR ANY OTHER DAMAGES,
+    INCLUDING BUT NOT LIMITED TO DAMAGES FOR LOSS OF PROFITS DATA OR USE OF THE
+    SOFTWARE OR FOR ANY INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, EVEN IF
+    THE MET OFFICE HAS BEEN SPECIFICALLY ADVISED OF THE POSSIBILITY OF SUCH
+    DAMAGES.</li>
+  </ol>
+
+  <h3>6. General Provisions.</h3>
+
+  <ol>
+    <li>You will not do anything, relating to this software that will bring the
+    Met Office into disrepute.</li>
+
+    <li>You will not use the name of the Met Office or any other contributor to
+    endorse or promote any products derived from the software without the
+    written permission of the Met Office.</li>
+  </ol>
+
+  <h3>7. Acknowledgements.</h3>
+
+  <p>The logic to extract the calling interfaces of top level subroutines and
+  functions from a Fortran source file is adapted from a script developed at
+  ECMWF and is provided by kind permission of ECMWF under the same terms of this
+  Licence.</p>
+
+  <h3>8. Entire Agreement.</h3>
+
+  <p>This License constitutes the entire agreement between us with respect to
+  your rights or warranties for using the software and related documentation.
+  If any provision of this agreement is determined to be invalid or
+  unenforceable the remaining provisions shall continue in full force.</p>
+
+  <h3>9. Governing Law.</h3>
+
+  <p>This Agreement is governed by and construed in accordance with the Laws of
+  England.</p>
+
+  <address>
+    &copy; British Crown copyright 2006-10.
+  </address>
+</body>
+</html>
Index: vendors/FCM/README
===================================================================
--- vendors/FCM/README	(revision 9621)
+++ vendors/FCM/README	(revision 9621)
@@ -0,0 +1,4 @@
+FCM release 1-5 created from revision 3579.
+
+For further details please refer to the release notes
+which can be found in the directory doc/release_notes.
Index: vendors/FCM/bin/fcm
===================================================================
--- vendors/FCM/bin/fcm	(revision 9621)
+++ vendors/FCM/bin/fcm	(revision 9621)
@@ -0,0 +1,66 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Fcm::CLI;
+use Fcm::Interactive;
+
+if (!caller()) {
+    main(@ARGV);
+}
+
+sub main {
+    local(@ARGV) = @_;
+    if (@ARGV && $ARGV[0] eq 'gui-internal') {
+        shift(@ARGV);
+        Fcm::Interactive::set_impl(
+            'Fcm::Interactive::InputGetter::GUI',
+            {geometry => shift(@ARGV)},
+        );
+    }
+    Fcm::CLI::invoke();
+}
+
+__END__
+
+=head1 NAME
+
+fcm
+
+=head1 SYNOPSIS
+
+fcm SUBCOMMAND [OPTIONS] [ARGUMENTS]
+
+=head1 OVERVIEW
+
+B<fcm> is the command line client for code management commands, the extract
+system and the build system of the Flexible Configuration Management (FCM)
+system.  For full detail of the system, please refer to the FCM user guide,
+which you should receive with this distribution in both HTML and PDF formats.
+
+Run "fcm help" to access the built-in tool documentation.
+
+=head1 AUTHOR
+
+FCM Team L<fcm-team@metoffice.gov.uk>.
+Please feedback any bug reports or feature requests to us by e-mail.
+
+=head1 SEE ALSO
+
+L<svn (1)|svn>,
+L<perl (1)| perl>,
+L<Fcm::CLI|Fcm::CLI>
+
+=head1 COPYRIGHT
+
+You can use this release of B<FCM> freely under the terms of the FCM LICENSE,
+which you should receive with this distribution.
+
+=cut
Index: vendors/FCM/bin/fcm_graphic_diff
===================================================================
--- vendors/FCM/bin/fcm_graphic_diff	(revision 9621)
+++ vendors/FCM/bin/fcm_graphic_diff	(revision 9621)
@@ -0,0 +1,96 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Getopt::Long qw{GetOptions};
+
+# ------------------------------------------------------------------------------
+
+my ($u, @label);
+GetOptions ('u' => \$u, 'L=s' => \@label);
+
+# Check existence of files
+for my $i (0 .. 1) {
+  die $ARGV[$i], ': not found, abort' unless $ARGV[$i] and -f $ARGV[$i];
+}
+
+my ($old, $new) = @ARGV;
+
+if ($old =~ m#.svn/empty-file$#) {
+  print 'Skipping new file', "\n\n";
+
+} elsif ($new =~ m#.svn/empty-file$#) {
+  print 'Skipping deleted file', "\n\n";
+
+} elsif (-z $old) {
+  print 'Skipping as old file is empty (or does not exist)', "\n\n";
+
+} elsif (-z $new) {
+  print 'Skipping as new file is empty (or deleted)', "\n\n";
+
+} elsif (-B $new) {
+  print 'Skipping binary file', "\n\n";
+
+} else {
+  # Print descriptions of files
+  if (@label >= 2) {
+    print '--- ', $label[0], "\n", '+++ ', $label[1], "\n\n";
+  }
+
+  # FCM_GRAPHIC_DIFF is the graphical diff tool command
+  my $cmd = (exists $ENV{FCM_GRAPHIC_DIFF} ? $ENV{FCM_GRAPHIC_DIFF} : 'xxdiff');
+
+  if ($cmd) {
+    my @options = ();
+
+    # Set options for labels if appropriate
+    if (@label >= 2) {
+      if ($cmd eq 'tkdiff') {
+        # Use tkdiff
+        @options = ('-L', $label[0], '-L', $label[1]);
+
+      } elsif ($cmd eq 'xxdiff') {
+        # Use xxdiff
+        @options = ('--title1', $label[0], '--title2', $label[1]);
+      }
+    }
+
+    # Execute the command
+    my @command = ($cmd, @options, $old, $new);
+    exec (@command) or die 'Cannot execute: ', join (' ', @command);
+  }
+
+  exit;
+}
+
+__END__
+
+=head1 NAME
+
+fcm_graphic_diff
+
+=head1 SYNOPSIS
+
+    fcm_graphic_diff [-u] [-L OLD_DESC] [-L NEW_DESC] OLD NEW
+
+=head1 DESCRIPTION
+
+Wrapper script which invokes a graphical diff tool. Its interface is
+compatible with the "svn diff" command and can be used in combination with
+its "--diff-cmd" option. The command prints the OLD_DESC and NEW_DESC if
+they are both set. The two arguments OLD and NEW must be set and are the
+files to compare. The graphical diff tool invoked depends on the value of
+the FCM_GRAPHIC_DIFF environment variable. The command exits if the
+environment variable is not set.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/bin/fcm_graphic_merge
===================================================================
--- vendors/FCM/bin/fcm_graphic_merge	(revision 9621)
+++ vendors/FCM/bin/fcm_graphic_merge	(revision 9621)
@@ -0,0 +1,83 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+my ($base, $mine, $older, $yours) = @ARGV;
+
+# FCM_GRAPHIC_MERGE is the graphical merge tool command
+my $cmd = (exists $ENV{FCM_GRAPHIC_MERGE} ? $ENV{FCM_GRAPHIC_MERGE} : 'xxdiff');
+
+my $rc  = 2;
+my $out = '';
+if ($cmd eq 'xxdiff') {
+  # Launch xxdiff
+  my @command   = ($cmd, qw/-m -M/, $base, qw/-O -X/, $mine, $older, $yours);
+  my ($cmd_out) = qx(@command);
+  my $cmd_rc    = $?;
+
+  # Parse output from xxdiff
+  if ($cmd_out) {
+    chomp $cmd_out;
+    if ($cmd_out eq 'NODECISION') {
+      $out = 'made no decision';
+      $rc  = 1;
+
+    } elsif ($cmd_out eq 'MERGED' and $cmd_rc) {
+      $out = 'not resolved all the conflicts';
+      $rc  = 1;
+
+    } else {
+      $out = lc ($cmd_out);
+      $rc  = 0;
+    }
+
+  } else {
+    print STDERR $cmd, ': failed, abort.', "\n";
+  }
+
+} else {
+  # Throw error for unknown/undefined graphic merge tool
+  print STDERR ($cmd ? $cmd . ': ' : ''),
+               'unknown/undefined graphic merge tool, abort.', "\n";
+}
+
+if ($rc == 1) {
+  # Merge unresolved
+  print 'You have ', $out, '.', "\n";
+
+} elsif ($rc == 0) {
+  # Merge resolved
+  print 'You ', $out, ' all the changes.', "\n";
+}
+
+exit $rc;
+
+__END__
+
+=head1 NAME
+
+fcm_graphic_merge
+
+=head1 SYNOPSIS
+
+    fcm_graphic_merge BASE MINE OLDER YOURS
+
+=head1 DESCRIPTION
+
+Wrapper script which invokes a graphical merge tool. It returns 0 on
+success, 1 if conflicts not resolved or 2 on failure. (This is similar to
+GNU diff3.) BASE is the file you want to save the merge result into. MINE
+is the original file. YOURS is the file you want MINE to merge with. OLDER
+is the common ancestor of MINE and YOURS.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/bin/fcm_gui
===================================================================
--- vendors/FCM/bin/fcm_gui	(revision 9621)
+++ vendors/FCM/bin/fcm_gui	(revision 9621)
@@ -0,0 +1,1346 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Cwd;
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Timer;
+use Fcm::Util;
+use File::Basename;
+use File::Spec;
+use Tk;
+use Tk::ROText;
+
+# ------------------------------------------------------------------------------
+
+# Argument
+if (@ARGV) {
+  my $dir = shift @ARGV;
+  chdir $dir if -d $dir;
+}
+
+# Get configuration settings
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# ------------------------------------------------------------------------------
+
+# FCM subcommands
+my @subcmds = qw/CHECKOUT BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT
+                 UPDATE SWITCH/;
+
+# Subcommands allowed when CWD is not a WC
+my @nwc_subcmds = qw/CHECKOUT BRANCH/;
+
+# Subcommands allowed, when CWD is a WC
+my @wc_subcmds = qw/STATUS BRANCH DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                    SWITCH/;
+
+# Subcommands that apply to WC only
+my @wco_subcmds = qw/BRANCH STATUS DIFF ADD DELETE MERGE CONFLICTS COMMIT UPDATE
+                     SWITCH/;
+
+# Subcommands that apply to top level WC only
+my @wcto_subcmds = qw/BRANCH MERGE COMMIT UPDATE SWITCH/;
+
+# Selected subcommand
+my $selsubcmd = '';
+
+# Selected subcommand is running?
+my $cmdrunning = 0;
+
+# PID of running subcommand
+my $cmdpid = undef;
+
+# List of subcommand frames
+my %subcmd_f;
+
+# List of subcommand buttons
+my %subcmd_b;
+
+# List of subcommand button help strings
+my %subcmd_help = (
+  BRANCH    => 'list information about, create or delete a branch.',
+  CHECKOUT  => 'check out a working copy from a repository.',
+  STATUS    => 'print the status of working copy files and directories.',
+  DIFF      => 'display the differences in modified files.',
+  ADD       => 'put files and directories under version control.',
+  DELETE    => 'remove files and directories from version control.',
+  MERGE     => 'merge changes into your working copy.',
+  CONFLICTS => 'use a graphical tool to resolve conflicts in your working copy.',
+  COMMIT    => 'send changes from your working copy to the repository.',
+  UPDATE    => 'bring changes from the repository into your working copy.',
+  SWITCH    => 'update your working copy to a different URL.',
+);
+
+for (keys %subcmd_help) {
+  $subcmd_help{$_} = 'Select the "' . lc ($_) . '" sub-command - ' .
+                     $subcmd_help{$_};
+}
+
+# List of subcommand button bindings (key name and underline position)
+my %subcmd_bind = (
+  BRANCH    => {KEY => '<Alt-Key-b>', U => 0},
+  CHECKOUT  => {KEY => '<Alt-Key-o>', U => 5},
+  STATUS    => {KEY => '<Alt-Key-s>', U => 0},
+  DIFF      => {KEY => '<Alt-Key-d>', U => 0},
+  ADD       => {KEY => '<Alt-Key-a>', U => 0},
+  DELETE    => {KEY => '<Alt-Key-t>', U => 4},
+  MERGE     => {KEY => '<Alt-Key-m>', U => 0},
+  CONFLICTS => {KEY => '<Alt-Key-f>', U => 3},
+  COMMIT    => {KEY => '<Alt-Key-c>', U => 0},
+  UPDATE    => {KEY => '<Alt-Key-u>', U => 0},
+  SWITCH    => {KEY => '<Alt-Key-w>', U => 1},
+);
+
+# List of subcommand variables
+my %subcmdvar = (
+  CWD       => cwd (),
+  WCT       => '',
+  CWD_URL   => '',
+  WCT_URL   => '',
+
+  BRANCH    => {
+    OPT     => 'info',
+    URL     => '',
+    NAME    => '',
+    TYPE    => 'DEV',
+    REVFLAG => 'NORMAL',
+    REV     => '',
+    TICKET  => '',
+    SRCTYPE => 'trunk',
+    S_CHD   => 0,
+    S_SIB   => 0,
+    S_OTH   => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  CHECKOUT  => {
+    URL     => '',
+    REV     => 'HEAD',
+    PATH    => '',
+    OTHER   => '',
+  },
+
+  STATUS    => {
+    USEWCT  => 0,
+    UPDATE  => 0,
+    VERBOSE => 0,
+    OTHER   => '',
+  },
+
+  DIFF      => {
+    USEWCT  => 0,
+    TOOL    => 'graphical',
+    BRANCH  => 0,
+    URL     => '',
+    OTHER   => '',
+  },
+
+  ADD       => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  DELETE    => {
+    USEWCT  => 0,
+    CHECK   => 1,
+    OTHER   => '',
+  },
+
+  MERGE     => {
+    USEWCT  => 1,
+    SRC     => '',
+    MODE    => 'automatic',
+    DRYRUN  => 0,
+    VERBOSE => 0,
+    REV     => '',
+    OTHER   => '',
+  },
+
+  CONFLICTS => {
+    USEWCT  => 0,
+    OTHER   => '',
+  },
+
+  COMMIT    => {
+    USEWCT  => 1,
+    DRYRUN  => 0,
+    OTHER   => '',
+  },
+
+  UPDATE    => {
+    USEWCT  => 1,
+    OTHER   => '',
+  },
+
+  SWITCH    => {
+    USEWCT  => 1,
+    URL     => '',
+    OTHER   => '',
+  },
+);
+
+# List of action buttons
+my %action_b;
+
+# List of action button help strings
+my %action_help = (
+  QUIT  => 'Quit fcm gui',
+  HELP  => 'Print help to the output text box for the selected sub-command',
+  CLEAR => 'Clear the output text box',
+  RUN   => 'Run the selected sub-command',
+);
+
+# List of action button bindings
+my %action_bind = (
+  QUIT  => {KEY => '<Control-Key-q>', U => undef},
+  HELP  => {KEY => '<F1>'           , U => undef},
+  CLEAR => {KEY => '<Alt-Key-l>'    , U => 1},
+  RUN   => {KEY => '<Alt-Key-r>'    , U => 0},
+);
+
+# List of branch subcommand options
+my %branch_opt = (
+  INFO   => undef,
+  CREATE => undef,
+  DELETE => undef,
+  LIST   => undef,
+);
+
+# List of branch create types
+my %branch_type = (
+  'DEV'         => undef,
+  'DEV::SHARE'  => undef,
+  'TEST'        => undef,
+  'TEST::SHARE' => undef,
+  'PKG'         => undef,
+  'PKG::SHARE'  => undef,
+  'PKG::CONFIG' => undef,
+  'PKG::REL'    => undef,
+);
+
+# List of branch create source type
+my %branch_srctype = (
+  TRUNK  => undef,
+  BRANCH => undef,
+);
+
+# List of branch create revision prefix option
+my %branch_revflag = (
+  NORMAL => undef,
+  NUMBER => undef,
+  NONE   => undef,
+);
+
+# List of branch info/delete options
+my %branch_info_opt = (
+  S_CHD   => 'Show children',
+  S_SIB   => 'Show siblings',
+  S_OTH   => 'Show other',
+  VERBOSE => 'Print extra information',
+);
+
+# List of diff display options
+my %diff_display_opt = (
+  default   => 'Default mode',
+  graphical => 'Graphical tool',
+  trac      => 'Trac (only for diff relative to the base of the branch)',
+);
+
+# Text in the status bar
+my $statustext = '';
+
+# ------------------------------------------------------------------------------
+
+my $mw = MainWindow->new ();
+
+my $mw_title = 'FCM GUI';
+$mw->title ($mw_title);
+
+# Frame containing subcommand selection buttons
+my $top_f = $mw->Frame ()->grid (
+  '-row'    => 0,
+  '-column' => 0,
+  '-sticky' => 'w',
+);
+
+# Frame containing subcommand options
+my $mid_f = $mw->Frame ()->grid (
+  '-row'    => 1,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Frame containing action buttons
+my $bot_f = $mw->Frame ()->grid (
+  '-row'    => 2,
+  '-column' => 0,
+  '-sticky' => 'ew',
+);
+
+# Text box to display output
+my $out_t  = $mw->Scrolled ('ROText', '-scrollbars' => 'osow')->grid (
+  '-row'    => 3,
+  '-column' => 0,
+  '-sticky' => 'news',
+);
+
+# Text box - allow scroll with mouse wheel
+$out_t->bind (
+  '<4>' => sub {
+    $_[0]->yview ('scroll', -1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+$out_t->bind (
+  '<5>' => sub {
+    $_[0]->yview ('scroll', +1, 'units') unless $Tk::strictMotif;
+  },
+);
+
+# Status bar
+$mw->Label (
+  '-textvariable' => \$statustext,
+  '-relief'       => 'groove',
+)->grid (
+  '-row'    => 4,
+  '-column' => 0,
+  '-sticky' => 'ews',
+);
+
+# Main window grid configure
+{
+  my ($cols, $rows) = $mw->gridSize ();
+  $mw->gridColumnconfigure ($_, '-weight' => 1) for (0 .. $cols - 1);
+  $mw->gridRowconfigure    ( 3, '-weight' => 1);
+}
+
+# Frame grid configure
+{
+  my ($cols, $rows) = $mid_f->gridSize ();
+  $bot_f->gridColumnconfigure (3, '-weight' => 1);
+}
+
+$mid_f->gridRowconfigure    (0, '-weight' => 1);
+$mid_f->gridColumnconfigure (0, '-weight' => 1);
+
+# ------------------------------------------------------------------------------
+
+# Buttons to select subcommands
+{
+  my $col = 0;
+  for my $name (@subcmds) {
+    $subcmd_b{$name} = $top_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => 'w',
+    );
+
+    $subcmd_b{$name}->bind ('<Enter>', sub {$statustext = $subcmd_help{$name}});
+    $subcmd_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $subcmd_b{$name}->configure ('-underline' => $subcmd_bind{$name}{U})
+      if defined $subcmd_bind{$name}{U};
+
+    $mw->bind ($subcmd_bind{$name}{KEY}, sub {$subcmd_b{$name}->invoke});
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Frames to contain subcommands options
+{
+  my %row = ();
+
+  for my $name (@subcmds) {
+    $subcmd_f{$name} = $mid_f->Frame ();
+    $subcmd_f{$name}->gridColumnconfigure (1, '-weight' => 1);
+
+    $row{$name} = 0;
+
+    # Widgets common to all sub-commands
+    $subcmd_f{$name}->Label ('-text' => 'Current working directory: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Label ('-textvariable' => \($subcmdvar{CWD}))->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'w',
+    );
+  }
+
+  # Widgets common to all sub-commands that apply to working copies
+  for my $name (@wco_subcmds) {
+    my @labtxts = (
+      'Corresponding URL: ',
+      'Working copy top: ',
+      'Corresponding URL: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{URL_CWD},
+      $subcmdvar{WCT},
+      $subcmdvar{URL_WCT},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Label ('-textvariable' => $varrefs[$i])->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+    }
+
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Apply sub-command to working copy top',
+      '-variable' => \($subcmdvar{$name}{USEWCT}),
+      '-state'    => (grep ({$_ eq $name} @wcto_subcmds) ? 'disabled' : 'normal'),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Branch sub-command
+  {
+    my $name = 'BRANCH';
+
+    # Radio buttons to select the sub-option of the branch sub-command
+    my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    my $col = 0;
+    for my $key (sort keys %branch_opt) {
+      my $opt = lc $key;
+
+      $branch_opt{$key} = $opt_f->Radiobutton (
+        '-text'     => $opt,
+        '-value'    => $opt,
+        '-variable' => \($subcmdvar{$name}{OPT}),
+        '-state'    => 'normal',
+      )->grid (
+        '-row'      => 0,
+        '-column'   => $col++,
+        '-sticky'   => 'w',
+      );
+    }
+
+    # Label and entry box for specifying URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch name
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch name (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{NAME}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry box for specifying create branch source revision
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source revision (create/list only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and radio buttons box for specifying create branch type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Branch type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_type) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create source type
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source type (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_srctype) {
+        my $txt = lc $key;
+        my $opt = lc $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{SRCTYPE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and radio buttons box for specifying create prefix option
+    $subcmd_f{$name}->Label (
+      '-text' => 'Prefix option (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (sort keys %branch_revflag) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{REVFLAG}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Label and entry box for specifying ticket number
+    $subcmd_f{$name}->Label (
+      '-text' => 'Related Trac ticket(s) (create only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{TICKET}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Check button for info/delete
+    # --show-children, --show-siblings, --show-other, --verbose
+    $subcmd_f{$name}->Label (
+      '-text' => 'Options for info/delete only: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+
+      for my $key (sort keys %branch_info_opt) {
+        $opt_f->Checkbutton (
+          '-text'     => $branch_info_opt{$key},
+          '-variable' => \($subcmdvar{$name}{$key}),
+        )->grid (
+          '-row'    => 0,
+          '-column' => $col++,
+          '-sticky' => 'w',
+        );
+      }
+    }
+  }
+
+  # Widget for the Checkout sub-command
+  {
+    my $name = 'CHECKOUT';
+
+    # Label and entry boxes for specifying URL and revision
+    my @labtxts = (
+      'URL: ',
+      'Revision: ',
+      'Path: ',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{URL},
+      $subcmdvar{$name}{REV},
+      $subcmdvar{$name}{PATH},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Label ('-text' => $labtxts[$i])->grid (
+        '-row'    => $row{$name},
+        '-column' => 0,
+        '-sticky' => 'w',
+      );
+      $subcmd_f{$name}->Entry (
+        '-textvariable' => $varrefs[$i],
+      )->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'ew',
+      );
+    }
+  }
+
+  # Widget for the Status sub-command
+  {
+    my $name = 'STATUS';
+
+    # Checkbuttons for various options
+    my @labtxts = (
+      'Display update information',
+      'Print extra information',
+    );
+    my @varrefs = \(
+      $subcmdvar{$name}{UPDATE},
+      $subcmdvar{$name}{VERBOSE},
+    );
+
+    for my $i (0 .. $#varrefs) {
+      $subcmd_f{$name}->Checkbutton (
+        '-text'     => $labtxts[$i],
+        '-variable' => $varrefs[$i],
+      )->grid (
+        '-row'        => $row{$name}++,
+        '-column'     => 0,
+        '-columnspan' => 2,
+        '-sticky'     => 'w',
+      );
+    }
+  }
+
+  # Widget for the Diff sub-command
+  {
+    my $name = 'DIFF';
+
+    my $entry;
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Show differences relative to the base of the branch',
+      '-variable' => \($subcmdvar{$name}{BRANCH}),
+      '-command'  => sub {
+        $entry->configure (
+          '-state' => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+        );
+      },
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and radio buttons box for specifying tool
+    $subcmd_f{$name}->Label (
+      '-text' => 'Display diff in: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/default graphical trac/) {
+        my $txt = $diff_display_opt{$key};
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{TOOL}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    $subcmd_f{$name}->Label ('-text' => 'Branch URL')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    $entry = $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+      '-state'        => ($subcmdvar{$name}{BRANCH} ? 'normal' : 'disabled'),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Add/Delete sub-command
+  for my $name (qw/ADD DELETE/) {
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Check for files or directories not under version control',
+      '-variable' => \($subcmdvar{$name}{CHECK}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Merge sub-command
+  {
+    my $name = 'MERGE';
+
+    # Label and radio buttons box for specifying merge mode
+    $subcmd_f{$name}->Label (
+      '-text' => 'Mode: ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+
+    {
+      my $opt_f = $subcmd_f{$name}->Frame ()->grid (
+        '-row'    => $row{$name}++,
+        '-column' => 1,
+        '-sticky' => 'w',
+      );
+
+      my $col = 0;
+      for my $key (qw/automatic custom reverse/) {
+        my $txt = lc $key;
+        my $opt = $key;
+
+        $branch_opt{$key} = $opt_f->Radiobutton (
+          '-text'     => $txt,
+          '-value'    => $opt,
+          '-variable' => \($subcmdvar{$name}{MODE}),
+          '-state'    => 'normal',
+        )->grid (
+          '-row'      => 0,
+          '-column'   => $col++,
+          '-sticky'   => 'w',
+        );
+      }
+    }
+
+    # Check buttons for dry-run
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Check buttons for verbose mode
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Print extra information',
+      '-variable' => \($subcmdvar{$name}{VERBOSE}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+
+    # Label and entry boxes for specifying merge source
+    $subcmd_f{$name}->Label (
+      '-text' => 'Source (automatic/custom only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{SRC}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+
+    # Label and entry boxes for specifying merge revision (range)
+    $subcmd_f{$name}->Label (
+      '-text' => 'Revision (custom/reverse only): ',
+    )->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{REV}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widget for the Commit sub-command
+  {
+    my $name = 'COMMIT';
+
+    # Checkbuttons for various options
+    $subcmd_f{$name}->Checkbutton (
+      '-text'     => 'Dry run',
+      '-variable' => \($subcmdvar{$name}{DRYRUN}),
+    )->grid (
+      '-row'        => $row{$name}++,
+      '-column'     => 0,
+      '-columnspan' => 2,
+      '-sticky'     => 'w',
+    );
+  }
+
+  # Widget for the Switch sub-command
+  {
+    my $name = 'SWITCH';
+
+    # Label and entry boxes for specifying switch URL
+    $subcmd_f{$name}->Label ('-text' => 'URL: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{URL}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+
+  # Widgets common to all sub-commands
+  for my $name (@subcmds) {
+    $subcmd_f{$name}->Label ('-text' => 'Other options: ')->grid (
+      '-row'    => $row{$name},
+      '-column' => 0,
+      '-sticky' => 'w',
+    );
+    $subcmd_f{$name}->Entry (
+      '-textvariable' => \($subcmdvar{$name}{OTHER}),
+    )->grid (
+      '-row'    => $row{$name}++,
+      '-column' => 1,
+      '-sticky' => 'ew',
+    );
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+# Buttons to perform main actions
+{
+  my $col = 0;
+  for my $name (qw/QUIT HELP CLEAR RUN/) {
+    $action_b{$name} = $bot_f->Button (
+      '-text'    => uc (substr ($name, 0, 1)) . lc (substr ($name, 1)),
+      '-command' => [\&button_clicked, $name],
+      '-width'   => 8,
+    )->grid (
+      '-row'    => 0,
+      '-column' => $col++,
+      '-sticky' => ($name eq 'RUN' ? 'ew' : 'w'),
+    );
+
+    $action_b{$name}->bind ('<Enter>', sub {$statustext = $action_help{$name}});
+    $action_b{$name}->bind ('<Leave>', sub {$statustext = ''});
+
+    $action_b{$name}->configure ('-underline' => $action_bind{$name}{U})
+      if defined $action_bind{$name}{U};
+
+    $mw->bind ($action_bind{$name}{KEY}, sub {$action_b{$name}->invoke});
+  }
+}
+
+&change_cwd ($subcmdvar{CWD});
+
+# ------------------------------------------------------------------------------
+
+# Handle the situation when the user attempts to quit the window while a
+# sub-command is running
+
+$mw->protocol ('WM_DELETE_WINDOW', sub {
+  if (defined $cmdpid) {
+    my $ans = $mw->messageBox (
+      '-title'   => $mw_title,
+      '-message' => $selsubcmd . ' is still running. Really quit?',
+      '-type'    => 'YesNo',
+      '-default' => 'No',
+    );
+
+    if ($ans eq 'Yes') {
+      kill 9, $cmdpid; # Need to kill the sub-process before quitting
+
+    } else {
+      return; # Do not quit
+    }
+  }
+
+  exit;
+});
+
+MainLoop;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &change_cwd ($dir);
+#
+# DESCRIPTION
+#   Change current working directory to $dir
+# ------------------------------------------------------------------------------
+
+sub change_cwd {
+  my $dir = $_[0];
+  my @allowed_subcmds = (&is_wc ($dir) ? @wc_subcmds : @nwc_subcmds);
+
+  for my $subcmd (@subcmds) {
+    if (grep {$_ eq $subcmd} @allowed_subcmds) {
+      $subcmd_b{$subcmd}->configure ('-state' => 'normal');
+
+    } else {
+      $subcmd_b{$subcmd}->configure ('-state' => 'disabled');
+    }
+  }
+
+  &display_subcmd_frame ($allowed_subcmds[0])
+    if not grep {$_ eq $selsubcmd} @allowed_subcmds;
+
+  chdir $dir;
+  $subcmdvar{CWD} = $dir;
+
+  if (&is_wc ($dir)) {
+    $subcmdvar{WCT}     = &get_wct ($dir);
+    $subcmdvar{URL_CWD} = &get_url_of_wc ($dir);
+    $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT});
+
+    $branch_opt{INFO}  ->configure ('-state' => 'normal');
+    $branch_opt{DELETE}->configure ('-state' => 'normal');
+    $subcmdvar{BRANCH}{OPT} = 'info';
+
+  } else {
+    $branch_opt{INFO}  ->configure ('-state' => 'disabled');
+    $branch_opt{DELETE}->configure ('-state' => 'disabled');
+    $subcmdvar{BRANCH}{OPT} = 'create';
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &button_clicked ($name);
+#
+# DESCRIPTION
+#   Call back function to handle a click on a command button named $name.
+# ------------------------------------------------------------------------------
+
+sub button_clicked {
+  my $name = $_[0];
+
+  if (grep {$_ eq $name} keys %subcmd_b) {
+    &display_subcmd_frame ($name);
+
+  } elsif ($name eq 'CLEAR') {
+    $out_t->delete ('1.0', 'end');
+
+  } elsif ($name eq 'QUIT') {
+    exit;
+
+  } elsif ($name eq 'HELP') {
+    &invoke_cmd ('help ' . lc ($selsubcmd));
+
+  } elsif ($name eq 'RUN') {
+    &invoke_cmd (&setup_cmd ($selsubcmd));
+
+  } else {
+    $out_t->insert ('end', $name . ': function to be implemented' . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &display_subcmd_frame ($name);
+#
+# DESCRIPTION
+#   Change selected subcommand to $name, and display the frame containing the
+#   widgets for configuring the options and arguments of that subcommand.
+# ------------------------------------------------------------------------------
+
+sub display_subcmd_frame {
+  my $name = $_[0];
+
+  if ($selsubcmd ne $name and not $cmdrunning) {
+    $subcmd_b{$name     }->configure ('-relief' => 'sunken');
+    $subcmd_b{$selsubcmd}->configure ('-relief' => 'raised') if $selsubcmd;
+
+    $subcmd_f{$name     }->grid ('-sticky' => 'new');
+    $subcmd_f{$selsubcmd}->gridForget if $selsubcmd;
+
+    $selsubcmd = $name;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $pos = &get_wm_pos ();
+#
+# DESCRIPTION
+#   Returns the position part of the geometry string of the main window.
+# ------------------------------------------------------------------------------
+
+sub get_wm_pos {
+  my $geometry = $mw->geometry ();
+  $geometry =~ /^=?(?:\d+x\d+)?([+-]\d+[+-]\d+)$/;
+  return $1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $command = &setup_cmd ($name);
+#
+# DESCRIPTION
+#   Setup the the system command for the sub-command $name.
+# ------------------------------------------------------------------------------
+
+sub setup_cmd {
+  my $name = $_[0];
+  my $cmd  = '';
+
+  if ($name eq 'BRANCH') {
+    $cmd .= lc ($name);
+    if ($subcmdvar{$name}{OPT} eq 'create') {
+      $cmd .= ' -c --svn-non-interactive';
+      $cmd .= ' -n '     . $subcmdvar{$name}{NAME} if $subcmdvar{$name}{NAME};
+      $cmd .= ' -t '     . $subcmdvar{$name}{TYPE};
+      $cmd .= ' --rev-flag ' . $subcmdvar{$name}{REVFLAG};
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+      $cmd .= ' -k ' . $subcmdvar{$name}{TICKET} if $subcmdvar{$name}{TICKET};
+      $cmd .= ' --branch-of-branch ' if $subcmdvar{$name}{SRCTYPE} eq 'branch';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'delete') {
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+      $cmd .= ' -d --svn-non-interactive';
+
+    } elsif ($subcmdvar{$name}{OPT} eq 'list') {
+      $cmd .= ' -l';
+      $cmd .= ' -r ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+
+    } else {
+      $cmd .= ' -i';
+      $cmd .= ' --show-children' if $subcmdvar{$name}{S_CHD};
+      $cmd .= ' --show-siblings' if $subcmdvar{$name}{S_SIB};
+      $cmd .= ' --show-other'    if $subcmdvar{$name}{S_OTH};
+      $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    }
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CHECKOUT') {
+    $cmd .= lc ($name);
+    $cmd .= ' -r' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+    $cmd .= ' ' . $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{PATH} if $subcmdvar{$name}{PATH};
+
+  } elsif ($name eq 'STATUS') {
+    $cmd .= lc ($name);
+    $cmd .= ' -u' if $subcmdvar{$name}{UPDATE};
+    $cmd .= ' -v' if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'DIFF') {
+    $cmd .= lc ($name);
+    $cmd .= ' -g' if $subcmdvar{$name}{TOOL} eq 'graphical';
+
+    if ($subcmdvar{$name}{BRANCH}) {
+      $cmd .= ' -b';
+      $cmd .= ' -t' if $subcmdvar{$name}{TOOL} eq 'trac';
+      $cmd .= ' ' . $subcmdvar{$name}{URL} if $subcmdvar{$name}{URL};
+    }
+
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'ADD' or $name eq 'DELETE') {
+    $cmd .= lc ($name);
+    $cmd .= ' -c' if $subcmdvar{$name}{CHECK};
+    $cmd .= ' --non-interactive'
+      if $name eq 'DELETE' and not $subcmdvar{$name}{CHECK};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'MERGE') {
+    $cmd .= lc ($name);
+
+    if ($subcmdvar{$name}{MODE} ne 'automatic') {
+      $cmd .= ' --' . $subcmdvar{$name}{MODE};
+      $cmd .= ' --revision ' . $subcmdvar{$name}{REV} if $subcmdvar{$name}{REV};
+    }
+
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' -v'        if $subcmdvar{$name}{VERBOSE};
+    $cmd .= ' ' . $subcmdvar{$name}{SRC}   if $subcmdvar{$name}{SRC};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'CONFLICTS') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'COMMIT') {
+    $cmd .= lc ($name);
+    $cmd .= ' --dry-run' if $subcmdvar{$name}{DRYRUN};
+    $cmd .= ' --svn-non-interactive';
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'SWITCH') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{URL}   if $subcmdvar{$name}{URL};
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  } elsif ($name eq 'UPDATE') {
+    $cmd .= lc ($name);
+    $cmd .= ' ' . $subcmdvar{$name}{OTHER} if $subcmdvar{$name}{OTHER};
+
+  }
+
+  return $cmd;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &invoke_cmd ($cmd);
+#
+# DESCRIPTION
+#   Invoke the command $cmd.
+# ------------------------------------------------------------------------------
+
+sub invoke_cmd {
+  my $cmd      = $_[0];
+  return unless $cmd;
+
+  my $disp_cmd = 'fcm ' . $cmd;
+  $cmd         = (index ($cmd, 'help ') == 0)
+                 ? $disp_cmd
+                 : ('fcm gui-internal ' . &get_wm_pos () . ' ' . $cmd);
+
+  # Change directory to working copy top if necessary
+  if ($subcmdvar{$selsubcmd}{USEWCT} and $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+    chdir $subcmdvar{WCT};
+    $out_t->insert ('end', 'cd ' . $subcmdvar{WCT} . "\n");
+    $out_t->yviewMoveto (1);
+  }
+
+  # Report start of command
+  $out_t->insert ('end', timestamp_command ($disp_cmd, 'Start'));
+  $out_t->yviewMoveto (1);
+
+  # Open the command as a pipe
+  if ($cmdpid = open CMD, '-|', $cmd . ' 2>&1') {
+    # Disable all action buttons
+    $action_b{$_}->configure ('-state' => 'disabled') for (keys %action_b);
+    $cmdrunning = 1;
+
+    # Set up a file event to read output from the command
+    $mw->fileevent (\*CMD, readable => sub {
+      if (sysread CMD, my ($buf), 1024) {
+        # Insert text into the output text box as it becomes available
+        $out_t->insert ('end', $buf);
+        $out_t->yviewMoveto (1);
+
+      } else {
+        # Delete the file event and close the file when the command finishes
+        $mw->fileevent(\*CMD, readable => '');
+        close CMD;
+        $cmdpid = undef;
+
+        # Check return status
+        if ($?) {
+          $out_t->insert (
+            'end', '"' . $disp_cmd . '" failed (' . $? . ')' . "\n",
+          );
+          $out_t->yviewMoveto (1);
+        }
+
+        # Report end of command
+        $out_t->insert ('end', timestamp_command ($disp_cmd, 'End'));
+        $out_t->yviewMoveto (1);
+
+        # Change back to CWD if necessary
+        if ($subcmdvar{$selsubcmd}{USEWCT} and
+            $subcmdvar{WCT} ne $subcmdvar{CWD}) {
+          chdir $subcmdvar{CWD};
+          $out_t->insert ('end', 'cd ' . $subcmdvar{CWD} . "\n");
+          $out_t->yviewMoveto (1);
+        }
+
+        # Enable all action buttons again
+        $action_b{$_}->configure ('-state' => 'normal') for (keys %action_b);
+        $cmdrunning = 0;
+
+        # If the command is "checkout", change directory to working copy
+        if (lc ($selsubcmd) eq 'checkout' && $subcmdvar{CHECKOUT}{URL}) {
+          my $url = Fcm::Keyword::expand($subcmdvar{CHECKOUT}{URL});
+          my $dir = $subcmdvar{CHECKOUT}{PATH}
+                  ? $subcmdvar{CHECKOUT}{PATH}
+                  : basename $url;
+          $dir    = File::Spec->rel2abs ($dir);
+          &change_cwd ($dir);
+
+        # If the command is "switch", change URL
+        } elsif (lc ($selsubcmd) eq 'switch') {
+          $subcmdvar{URL_CWD} = &get_url_of_wc ($subcmdvar{CWD}, 1);
+          $subcmdvar{URL_WCT} = &get_url_of_wc ($subcmdvar{WCT}, 1);
+        }
+      }
+      1;
+    });
+
+  } else {
+    $mw->messageBox (
+      '-title'   => 'Error',
+      '-message' => 'Error running "' . $cmd . '"',
+      '-icon'    => 'error',
+    );
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
+
+=head1 NAME
+
+fcm_gui
+
+=head1 SYNOPSIS
+
+fcm_gui [DIR]
+
+=head1 DESCRIPTION
+
+The fcm_gui command is a simple graphical user interface for some of the
+commands of the FCM system. The optional argument DIR modifies the initial
+working directory.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/bin/fcm_internal
===================================================================
--- vendors/FCM/bin/fcm_internal	(revision 9621)
+++ vendors/FCM/bin/fcm_internal	(revision 9621)
@@ -0,0 +1,615 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Fcm::Timer qw{timestamp_command};
+
+# Function declarations
+sub catfile;
+sub basename;
+sub dirname;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %unusual_tool_name = ();
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  # Name of program
+  my $this = basename $0;
+
+  # Arguments
+  my $subcommand = shift @ARGV;
+  my ($function, $type) = split /:/, $subcommand; 
+
+  my ($srcpackage, $src, $target, $requirepp, @objects, @blockdata);
+  
+  if ($function eq 'archive') {
+    ($target, @objects) = @ARGV;
+
+  } elsif ($function eq 'load') {
+    ($srcpackage, $src, $target, @blockdata) = @ARGV;
+
+  } else {
+    ($srcpackage, $src, $target, $requirepp) = @ARGV;
+  }
+
+  # Set up hash reference for all the required information
+  my %info = (
+    SRCPACKAGE => $srcpackage,
+    SRC        => $src,
+    TYPE       => $type,
+    TARGET     => $target,
+    REQUIREPP  => $requirepp,
+    OBJECTS    => \@objects,
+    BLOCKDATA  => \@blockdata,
+  );
+
+  # Get list of unusual tools
+  my $i = 0;
+  while (my $label = &get_env ('FCM_UNUSUAL_TOOL_LABEL' . $i)) {
+    my $value = &get_env ('FCM_UNUSUAL_TOOL_VALUE' . $i);
+    $unusual_tool_name{$label} = $value;
+    $i++;
+  }
+
+  # Invoke the action
+  my $rc = 0;
+  if ($function eq 'compile') {
+    $rc = &compile (\%info);
+
+  } elsif ($function eq 'load') {
+    $rc = &load (\%info);
+
+  } elsif ($function eq 'archive') {
+    $rc = &archive (\%info);
+
+  } else {
+    print STDERR $this, ': incorrect usage, abort';
+    $rc = 1;
+  }
+
+  # Throw error if action failed
+  if ($rc) {
+    print STDERR $this, ' ', $function, ' failed (', $rc, ')', "\n";
+    exit 1;
+
+  } else {
+    exit;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &compile (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct compiler with the correct options to
+#   compile the source file into the required target. The argument $info is a
+#   hash reference set up in MAIN. The following environment variables are
+#   used, where * is the source file type (F for Fortran, and C for C/C++):
+# 
+#   *C          - compiler command
+#   *C_OUTPUT   - *C option to specify the name of the output file
+#   *C_DEFINE   - *C option to declare a pre-processor def
+#   *C_INCLUDE  - *C option to declare an include directory
+#   *C_MODSEARCH- *C option to declare a module search directory
+#   *C_COMPILE  - *C option to ask the compiler to perform compile only
+#   *CFLAGS     - *C user options
+#   *PPKEYS     - list of pre-processor defs (may have sub-package suffix)
+#   FCM_VERBOSE - verbose level
+#   FCM_OBJDIR  - destination directory of object file
+#   FCM_TMPDIR  - temporary destination directory of object file
+# ------------------------------------------------------------------------------
+
+sub compile {
+  my $info = shift;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  my @command = ();
+
+  # Guess file type for backward compatibility
+  my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
+
+  # Compiler
+  push @command, &get_env ($type . 'C', 1);
+
+  # Compile output target (typical -o option)
+  push @command, &get_env ($type . 'C_OUTPUT', 1), $info->{TARGET};
+
+  # Pre-processor definition macros
+  if ($info->{REQUIREPP}) {
+    my @ppkeys = split /\s+/, &select_flags ($info, $type . 'PPKEYS');
+    my $defopt = &get_env ($type . 'C_DEFINE', 1);
+
+    push @command, (map {$defopt . $_} @ppkeys);
+  }
+
+  # Include search path
+  my $incopt  = &get_env ($type . 'C_INCLUDE', 1);
+  my @incpath = split /:/, &get_env ('FCM_INCPATH');
+  push @command, (map {$incopt . $_} @incpath);
+
+  # Compiled module search path
+  my $modopt  = &get_env ($type . 'C_MODSEARCH');
+  if ($modopt) {
+    push @command, (map {$modopt . $_} @incpath);
+  }
+
+  # Other compiler flags
+  my $flags = &select_flags ($info, $type . 'FLAGS');
+  push @command, $flags if $flags;
+
+  my $compile_only = &get_env ($type . 'C_COMPILE');
+  if ($flags !~ /(?:^|\s)$compile_only\b/) {
+    push @command, &get_env ($type . 'C_COMPILE');
+  }
+
+  # Name of source file
+  push @command, $info->{SRC};
+
+  # Execute command
+  my $objdir = &get_env ('FCM_OBJDIR', 1);
+  my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+  chdir $tmpdir;
+
+  my $command = join ' ', @command;
+  if ($verbose > 1) {
+    print 'cd ', $tmpdir, "\n";
+    print &timestamp_command ($command, 'Start');
+
+  } elsif ($verbose) {
+    print $command, "\n";
+  }
+
+  my $rc = system $command;
+
+  print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $info->{TARGET};
+
+  } else {   # success
+    print 'mv ', $info->{TARGET}, ' ', $objdir, "\n" if $verbose > 1;
+    rename $info->{TARGET}, &catfile ($objdir, $info->{TARGET});
+  }
+
+  # Move any Fortran module definition files to the INC directory
+  my @modfiles = <*.mod *.MOD>;
+  for my $file (@modfiles) {
+    rename $file, &catfile ($incpath[0], $file);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &load (\%info);
+#
+# DESCRIPTION
+#   This method invokes the correct loader with the correct options to link
+#   the main program object into an executable. The argument $info is a hash
+#   reference set up in MAIN. The following environment variables are used:
+# 
+#   LD           - * linker command
+#   LD_OUTPUT    - LD option to specify the name of the output file
+#   LD_LIBSEARCH - LD option to declare a directory in the library search path
+#   LD_LIBLINK   - LD option to declare an object library
+#   LDFLAGS      - LD user options
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_BINDIR   - destination directory of executable file
+#   FCM_TMPDIR   - temporary destination directory of executable file
+#
+#   * If LD is not set, it will attempt to guess the file type and use the
+#     compiler as the linker.
+# ------------------------------------------------------------------------------
+
+sub load {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Create temporary object library
+  (my $name   = $info->{TARGET}) =~ s/\.\S+$//;
+  my $libname = '__fcm__' . $name;
+  my $lib     = 'lib' . $libname . '.a';
+  my $libfile = catfile (&get_env ('FCM_LIBDIR', 1), $lib);
+  $rc = &archive ({TARGET => $lib});
+
+  unless ($rc) {
+    my @command = ();
+
+    # Linker
+    my $ld = &select_flags ($info, 'LD');
+    if (not $ld) {
+      # Guess file type for backward compatibility
+      my $type = $info->{TYPE} ? $info->{TYPE} : &guess_file_type ($info->{SRC});
+      $ld = &get_env ($type . 'C', 1);
+    }
+    push @command, $ld;
+
+    # Linker output target (typical -o option)
+    push @command, &get_env ('LD_OUTPUT', 1), $info->{TARGET};
+
+    # Name of main object file
+    my $mainobj = (basename ($info->{SRC}) eq $info->{SRC})
+                  ? catfile (&get_env ('FCM_OBJDIR'), $info->{SRC})
+                  : $info->{SRC};
+    push @command, $mainobj;
+
+    # Link with Fortran BLOCKDATA objects if necessary
+    if (@{ $info->{BLOCKDATA} }) {
+      my @blockdata = @{ $info->{BLOCKDATA} };
+      my @objpath   = split /:/, &get_env ('FCM_OBJPATH');
+
+      # Search each BLOCKDATA object file from the object search path
+      for my $file (@blockdata) {
+        for my $dir (@objpath) {
+          my $full = catfile ($dir, $file);
+
+          if (-r $full) {
+            $file = $full;
+            last;
+          }
+        }
+
+        push @command, $file;
+      }
+    }
+
+    # Library search path
+    my $libopt  = &get_env ('LD_LIBSEARCH', 1);
+    my @libpath = split /:/, &get_env ('FCM_LIBPATH');
+    push @command, (map {$libopt . $_} @libpath);
+
+    # Link with temporary object library if it exists
+    push @command, &get_env ('LD_LIBLINK', 1) . $libname if -f $libfile;
+
+    # Other linker flags
+    my $flags = &select_flags ($info, 'LDFLAGS');
+    push @command, $flags;
+
+    # Execute command
+    my $tmpdir = &get_env ('FCM_TMPDIR', 1);
+    my $bindir = &get_env ('FCM_BINDIR', 1);
+    chdir $tmpdir;
+
+    my $command = join ' ', @command;
+    if ($verbose > 1) {
+      print 'cd ', $tmpdir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } elsif ($verbose) {
+      print $command, "\n";
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ') if $verbose > 1;
+
+    # Move temporary output to correct location on success
+    # Otherwise, remove temporary output
+    if ($rc) { # error
+      unlink $info->{TARGET};
+
+    } else {   # success
+      print 'mv ', $info->{TARGET}, ' ', $bindir, "\n" if $verbose > 1;
+      rename $info->{TARGET}, &catfile ($bindir, $info->{TARGET});
+    }
+  }
+
+  # Remove the temporary object library
+  unlink $libfile if -f $libfile;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &archive (\%info);
+#
+# DESCRIPTION
+#   This method invokes the library archiver to create an object library. The
+#   argument $info is a hash reference set up in MAIN. The following
+#   environment variables are used:
+# 
+#   AR           - archiver command
+#   ARFLAGS      - AR options to update/create an object library
+#   FCM_VERBOSE  - verbose level
+#   FCM_LIBDIR   - destination directory of object libraries
+#   FCM_OBJPATH  - search path of object files
+#   FCM_OBJDIR   - destination directory of object files
+#   FCM_TMPDIR   - temporary destination directory of executable file
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $info = shift;
+
+  my $rc = 0;
+
+  # Verbose mode
+  my $verbose = &get_env ('FCM_VERBOSE');
+  $verbose    = 1 unless defined ($verbose);
+
+  # Set up the archive command
+  my $lib     = &basename ($info->{TARGET});
+  my $tmplib  = &catfile (&get_env ('FCM_TMPDIR', 1), $lib);
+  my @ar_cmd  = ();
+  push @ar_cmd, (&get_env ('AR', 1), &get_env ('ARFLAGS', 1));
+  push @ar_cmd, $tmplib;
+
+  # Get object directories and their files
+  my %objdir;
+  if (exists $info->{OBJECTS}) {
+    # List of objects set in the argument, sort into directory/file list
+    for my $name (@{ $info->{OBJECTS} }) {
+      my $dir = (&dirname ($name) eq '.')
+                ? &get_env ('FCM_OBJDIR', 1) : &dirname ($name);
+      $objdir{$dir}{&basename ($name)} = 1;
+    }
+
+  } else {
+    # Objects not listed in argument, search object path for all files
+    my @objpath  = split /:/, &get_env ('FCM_OBJPATH', 1);
+    my %objbase  = ();
+
+    # Get registered objects into a hash (keys = objects, values = 1)
+    my %objects = map {($_, 1)} split (/\s+/, &get_env ('OBJECTS'));
+
+    # Seach object path for all files
+    for my $dir (@objpath) {
+      next unless -d $dir;
+
+      chdir $dir;
+
+      # Use all files from each directory in the object search path
+      for ((glob ('*'))) {
+        next unless exists $objects{$_}; # consider registered objects only
+        $objdir{$dir}{$_} = 1 unless exists $objbase{$_};
+        $objbase{$_} = 1;
+      }
+    }
+  }
+
+  for my $dir (sort keys %objdir) {
+    next unless -d $dir;
+
+    # Go to each object directory and executes the library archive command 
+    chdir $dir;
+    my $command = join ' ', (@ar_cmd, sort keys %{ $objdir{$dir} });
+
+    if ($verbose > 1) {
+      print 'cd ', $dir, "\n";
+      print &timestamp_command ($command, 'Start');
+
+    } else {
+      print $command, "\n" if exists $info->{OBJECTS};
+    }
+
+    $rc = system $command;
+
+    print &timestamp_command ($command, 'End  ')
+      if $verbose > 1;
+    last if $rc;
+  }
+
+  # Move temporary output to correct location on success
+  # Otherwise, remove temporary output
+  if ($rc) { # error
+    unlink $tmplib;
+
+  } else {   # success
+    my $libdir = &get_env ('FCM_LIBDIR', 1);
+
+    print 'mv ', $tmplib, ' ', $libdir, "\n" if $verbose > 1;
+    rename $tmplib, &catfile ($libdir, $lib);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = &guess_file_type ($filename);
+#
+# DESCRIPTION
+#   This function attempts to guess the file type by looking at the extension
+#   of the $filename. Only C and Fortran at the moment.
+# ------------------------------------------------------------------------------
+
+sub guess_file_type {
+  return (($_[0] =~ /\.c(\w+)?$/i) ? 'C' : 'F');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flags = &select_flags (\%info, $set);
+#
+# DESCRIPTION
+#   This function selects the correct compiler/linker flags for the current
+#   sub-package from the environment variable prefix $set. The argument $info
+#   is a hash reference set up in MAIN.
+# ------------------------------------------------------------------------------
+
+sub select_flags {
+  my ($info, $set) = @_;
+
+  my $srcbase = &basename ($info->{SRC});
+  my @names    = ($set);
+  push @names, split (/__/, $info->{SRCPACKAGE} . '__' . $srcbase);
+
+  my $string = '';
+  for my $i (reverse (0 .. $#names)) {
+    my $var  = &get_env (join ('__', (@names[0 .. $i])));
+
+    $var = &get_env (join ('__', (@names[0 .. $i])))
+      if (not defined ($var)) and $i and $names[-1] =~ s/\.[^\.]+$//;
+
+    next unless defined $var;
+    $string = $var;
+    last;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $variable = &get_env ($name);
+#   $variable = &get_env ($name, $compulsory);
+#
+# DESCRIPTION
+#   This internal method gets a variable from $ENV{$name}. If $compulsory is
+#   set to true, it throws an error if the variable is a not set or is an empty
+#   string. Otherwise, it returns C<undef> if the variable is not set.
+# ------------------------------------------------------------------------------
+
+sub get_env {
+  (my $name, my $compulsory) = @_;
+  my $string;
+
+  if ($name =~ /^\w+$/) {
+    # $name contains only word characters, variable is exported normally
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $ENV{$name};
+
+    $string = exists $ENV{$name} ? $ENV{$name} : undef;
+
+  } else {
+    # $name contains unusual characters
+    die 'The environment variable "', $name, '" must be set, abort'
+      if $compulsory and not exists $unusual_tool_name{$name};
+
+    $string = exists $unusual_tool_name{$name}
+              ? $unusual_tool_name{$name} : undef;
+  }
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = &catfile (@paths);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Spec module.
+# ------------------------------------------------------------------------------
+
+sub catfile {
+  my @names = split (m!/!, join ('/', @_));
+  my $path  = shift @names;
+
+  for my $name (@names) {
+    $path .= '/' . $name if $name;
+  }
+
+  return $path;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $basename = &basename ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub basename {
+  my $name = $_[0];
+
+  $name =~ s{/*$}{}; # remove trailing slashes
+
+  if ($name =~ m#.*/([^/]+)$#) {
+    return $1;
+
+  } else {
+    return $name;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dirname = &dirname ($path);
+#
+# DESCRIPTION
+#   This is a local implementation of what is in the File::Basename module.
+# ------------------------------------------------------------------------------
+
+sub dirname {
+  my $name = $_[0];
+
+  if ($name =~ m#^/+$#) {
+    return '/'; # dirname of root is root
+
+  } else {
+    $name =~ s{/*$}{}; # remove trailing slashes
+
+    if ($name =~ m#^(.*)/[^/]+$#) {
+      my $dir = $1;
+      $dir =~ s{/*$}{}; # remove trailing slashes
+      return $dir;
+
+    } else {
+      return '.';
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+__END__
+
+=head1 NAME
+
+fcm_internal
+
+=head1 SYNOPSIS
+
+    fcm_internal SUBCOMMAND ARGS
+
+=head1 DESCRIPTION
+
+The fcm_internal command is a frontend for some of the internal commands of
+the FCM build system. The subcommand can be "compile", "load" or "archive"
+for invoking the compiler, loader and library archiver respectively. If
+"compile" or "load" is specified, it can be suffixed with ":TYPE" to
+specify the nature of the source file. If TYPE is not specified, it is set
+to C if the file extension begins with ".c". For all other file types, it
+is set to F (for Fortran source). For compile and load, the other arguments
+are 1) the name of the container package of the source file, 2) the path to
+the source file and 3) the target name after compiling or loading the
+source file. For compile, the 4th argument is a flag to indicate whether
+pre-processing is required for compiling the source file.  For load, the
+4th and the rest of the arguments is a list of object files that cannot be
+archived into the temporary load library and must be linked into the target
+through the linker command. (E.g. Fortran BLOCKDATA program units must be
+linked this way.) If archive is specified, the first argument should be the
+name of the library archive target and the rest should be the object files
+to be included in the archive. This command is invoked via the build system
+and should never be called directly by the user.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/bin/fcm_setup_konqueror
===================================================================
--- vendors/FCM/bin/fcm_setup_konqueror	(revision 9621)
+++ vendors/FCM/bin/fcm_setup_konqueror	(revision 9621)
@@ -0,0 +1,47 @@
+#!/bin/sh
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm_setup_konqueror
+#
+# SYNOPSIS
+#   fcm_setup_konqueror
+#
+# DESCRIPTION
+#   Set up Konqueror to use "fcm gui".
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+# Check number of arguments
+script=`basename $0`
+usage="$script: no argument required"
+if (( $# != 0 )); then
+  echo "$usage, abort..." >&2
+  exit 1
+fi
+
+filename=fcm_gui.desktop
+
+file=`dirname $0`
+if [[ `basename $file` = bin ]]; then
+  file=`dirname $file`
+fi
+file=$file/etc/$filename
+
+if [[ ! -f $file ]]; then
+  echo "$script: $file not found, abort..." >&2
+  exit 1
+fi
+
+dir=$HOME/.kde/share/applnk/.hidden
+mkdir -p $dir
+cd $dir
+rm -f $filename             # Always remove.
+ln -s $file .
+
+echo "$script: finished"
+
+#EOF
Index: vendors/FCM/bin/fcm_update_version_dir.pl
===================================================================
--- vendors/FCM/bin/fcm_update_version_dir.pl	(revision 9621)
+++ vendors/FCM/bin/fcm_update_version_dir.pl	(revision 9621)
@@ -0,0 +1,289 @@
+#!/usr/bin/env perl
+#-------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+#-------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use Cwd qw{cwd};
+use Getopt::Long qw{GetOptions};
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Util qw{get_url_of_wc get_wct is_wc run_command tidy_url};
+use File::Basename qw{basename dirname};
+use File::Path qw{mkpath};
+use File::Spec;
+use Pod::Usage qw{pod2usage};
+
+# Usage
+# ------------------------------------------------------------------------------
+my $this  = basename($0);
+
+# Options
+# ------------------------------------------------------------------------------
+my ($dest, $full, $help, $url);
+my $rc = GetOptions(
+  'dest|d=s' => \$dest,
+  'full|f'   => \$full,
+  'help'     => \$help,
+  'url|u=s'  => \$url,
+);
+if (!$rc) {
+  pod2usage({'-verbose' => 1});
+}
+if ($help) {
+  pod2usage({'-exitval' => 0, '-verbose' => 1});
+}
+if (!$url) {
+  pod2usage(
+    {'-message' => 'The --url=URL option is compulsory', '-verbose' => 1},
+  );
+}
+$dest ||= cwd();
+
+# Arguments
+# ------------------------------------------------------------------------------
+if (@ARGV) {
+  die 'Cannot read: ', $ARGV[0], ', abort' unless -f $ARGV[0] and -r $ARGV[0];
+}
+
+# Get configuration settings
+# ------------------------------------------------------------------------------
+my $config = Fcm::Config->new ();
+$config->get_config ();
+
+# Expand URL keyword
+$url = Fcm::Util::tidy_url(Fcm::Keyword::expand($url));
+
+# ------------------------------------------------------------------------------
+
+MAIN: {
+  my $date = localtime;
+  print $this, ': started on ', $date, "\n";
+
+  my %dirs;
+
+  # Read input (file) for a list directories and update conditions
+  while (<>) {
+    chomp;
+
+    # Ignore empty and comment lines
+    next if /^\s*(?:#|$)/;
+
+    # Each line must contain a relative path, and optionally a list of
+    # space delimited conditions
+    my @words = split /\s+/;
+    my $dir   = shift @words;
+
+    # Check that the conditions are valid
+    my @conditions;
+    for my $word (@words) {
+      if ($word =~ /^([<>]=?|[!=]=)(.+)$/i) {
+        # Condition must be a conditional operator followed by a revision
+        my ($operator, $rev) = ($1, $2);
+        $rev = (Fcm::Keyword::expand($url, $rev))[1];
+        push @conditions, $operator . $rev;
+
+      } else {
+        print STDERR 'Warning: ignore unknown syntax for update condition: ',
+                     $word, "\n";
+      }
+    }
+
+    # Add directory and its conditions to a hash
+    if ($dir =~ s#/\*$##) { # Directory finishes with wildcard
+
+      # Run "svn ls" in recursive mode
+      my $dirurl  = join ('/', ($url, $dir));
+      my @files   = &run_command ([qw/svn ls -R/, $dirurl], METHOD => 'qx');
+
+      # Find directories containing regular files
+      while (my $file = shift @files) {
+	# Skip directories
+	next if $file =~ m#/$#;
+
+	# Get "dirname" of regular file and add to hash
+	my $subdir = join ('/', ($dir, dirname ($file)));
+	$dirs{$subdir} = \@conditions;
+      }
+
+    } else {
+      $dirs{$dir} = \@conditions;
+    }
+
+  }
+
+  # Update each directory, if required
+  for my $dir (sort keys %dirs) {
+    # Use "svn log" to determine the revisions that need to be updated
+    my %allversions;
+    {
+      my $command = 'svn log -q ' . join ('/', ($url, $dir));
+      my @log     = &run_command (
+        [qw/svn log -q/, join ('/', ($url, $dir))], METHOD => 'qx',
+      );
+      @log        = grep /^r\d+/, @log;
+
+      # Assign a sequential "version" number to each sub-directory
+      my $version = scalar @log;
+      for (@log) {
+        m/^r(\d+)/;
+        $allversions{$1} = 'v' . $version--;
+      }
+    }
+    my %versions = %allversions;
+
+    # Extract only revisions matching the conditions
+    if (@{ $dirs{$dir} }) {
+      my @conditions = @{ $dirs{$dir} };
+
+      for my $condition (@conditions) {
+        for my $rev (keys %versions) {
+          delete $versions{$rev} unless eval ($rev . $condition);
+        }
+      }
+    }
+
+    # Destination directory
+    my $dirpath = File::Spec->catfile ($dest, $dir);
+
+    if (-d $dirpath) {
+      if ($full or not keys %versions) {
+        # Remove destination directory top, in full mode
+        # or if there are no matching revisions
+        &run_command ([qw/rm -rf/, $dirpath], PRINT => 1);
+
+      } else {
+        # Delete excluded revisions if they exist, in incremental mode
+        if (opendir DIR, $dirpath) {
+          while (my $rev = readdir 'DIR') {
+            next unless $rev =~ /^\d+$/;
+
+            if (not grep {$_ eq $rev} keys %versions) {
+              my @command = (qw/rm -rf/, File::Spec->catfile ($dirpath, $rev));
+              &run_command (\@command, PRINT => 1);
+
+              # Remove "version" symlink
+              my $verlink = File::Spec->catfile ($dirpath, $allversions{$rev});
+              unlink $verlink if -l $verlink;
+            }
+          }
+          closedir DIR;
+        }
+      }
+    }
+
+    # Create container directory of destination if it does not already exist
+    if (keys %versions and not -d $dirpath) {
+      print '-> mkdir -p ', $dirpath, "\n";
+      my $rc = mkpath $dirpath;
+      die 'mkdir -p ', $dirpath, ' failed' unless $rc;
+    }
+
+    # Update each version directory that needs updating
+    for my $rev (keys %versions) {
+      my $revpath = File::Spec->catfile ($dest, $dir, $rev);
+
+      # Create version directory if it does not exist
+      if (not -e $revpath) {
+        # Use "svn export" to create the version directory
+        my @command = (
+          qw/svn export -q -r/,
+          $rev,
+          join ('/', ($url, $dir)),
+          $revpath,
+        );
+
+        &run_command (\@command, PRINT => 1);
+      }
+
+      # Create "version" symlink if necessary
+      my $verlink = File::Spec->catfile ($dest, $dir, $versions{$rev});
+      symlink $rev, $verlink unless -l $verlink;
+    }
+
+    # Symbolic link to the "latest" version directory
+    my $headlink = File::Spec->catfile ($dest, $dir, 'latest');
+    my $headrev  = 0;
+    for my $rev (keys %versions) {
+      $headrev = $rev if $rev > $headrev;
+    }
+
+    if (-l $headlink) {
+      # Remove old symbolic link if there is no revision to update or if it
+      # does not point to the correct version directory
+      my $org = readlink $headlink;
+      unlink $headlink if (! $headrev or $org ne $headrev);
+    }
+
+    # (Re-)create the "latest" symbolic link, if necessary
+    symlink $headrev, $headlink if ($headrev and not -l $headlink);
+  }
+
+  $date = localtime;
+  print $this, ': finished normally on ', $date, "\n";
+}
+
+__END__
+
+=head1 NAME
+
+fcm_update_version_dir.pl
+
+=head1 SYNOPSIS
+
+    fcm_update_version_dir.pl [OPTIONS] [CFGFILE]
+
+=head1 DESCRIPTION
+
+Update the version directories for a list of relative paths in the source
+repository URL.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dest=DEST, -d DEST
+
+Specify a destination for the extraction. If not specified, the command extracts
+to the current working directory.
+
+=item --help, -h
+
+Print help and exit.
+
+=item --full, -f
+
+Specify the full mode. If not specified, the command runs in incremental mode.
+
+=item --url=URL, -u URL
+
+Specify the source repository URL. No default.
+
+=back
+
+=head1 ARGUMENTS
+
+A configuration file may be given to this command, or it will attempt to read
+from the standard input. Each line in the configuration must contain a relative
+path that resides under the given source repository URL. (Empty lines and lines
+beginning with a "#" are ignored.) Optionally, each relative path may be
+followed by a list of space separated "conditions".  Each condition is a
+conditional operator (>, >=, <, <=, == or !=) followed by a revision number or
+the keyword HEAD. The command uses the revision log to determine the revisions
+at which the relative path has been updated in the source repository URL. If
+these revisions also satisfy the "conditions" set by the user, they will be
+considered in the extraction.  In full mode, everything is re-extracted. In
+incremental mode, the version directories are only updated if they do not
+already exist.
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/etc/fcm.cfg.eg
===================================================================
--- vendors/FCM/etc/fcm.cfg.eg	(revision 9621)
+++ vendors/FCM/etc/fcm.cfg.eg	(revision 9621)
@@ -0,0 +1,266 @@
+# ------------------------------------------------------------------------------
+# FCM central configuration file
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Standard repository locations
+# ------------------------------------------------------------------------------
+
+# 3dVOM repository
+set::url::3dvom              svn://fcm9/3dVOM_svn/3dVOM
+
+# AAPP repository
+set::url::aapp               svn://fcm7/AAPP_svn/AAPP
+
+# AMV repository
+set::url::amv                svn://fcm7/AMV_svn/AMV
+
+# ANCIL repository
+set::url::ancil              svn://fcm8/ANCIL_svn/ANCIL
+
+# ATSR repository
+set::url::atsr               svn://fcm7/ATSR_svn/ATSR
+
+# BLASIUS repository
+set::url::blasius            svn://fcm2/BLASIUS_svn/BLASIUS		      
+
+# CICE repository
+set::url::cice               svn://fcm3/CICE_svn/CICE
+
+# CMA repository
+set::url::cma                svn://fcm9/CMA_svn/CMA
+
+# CVC repository
+set::url::cvc_admin          svn://fcm6/CVC_svn/Admin
+set::url::bufr               svn://fcm6/CVC_svn/BUFR
+set::url::bullseye           svn://fcm6/CVC_svn/Bullseye
+set::url::cat                svn://fcm6/CVC_svn/CAT
+set::url::deicing            svn://fcm6/CVC_svn/Deicing
+set::url::ea                 svn://fcm6/CVC_svn/EA  
+set::url::ensemble           svn://fcm6/CVC_svn/Ensemble
+set::url::gales              svn://fcm6/CVC_svn/Gales
+set::url::ifv                svn://fcm6/CVC_svn/IFV
+set::url::mogreps            svn://fcm6/CVC_svn/MOGREPS
+set::url::openroad           svn://fcm6/CVC_svn/OpenRoad
+set::url::powertable         svn://fcm6/CVC_svn/PowerTable
+set::url::qnh                svn://fcm6/CVC_svn/QNH
+set::url::tafs               svn://fcm6/CVC_svn/TAFS
+set::url::warnings           svn://fcm6/CVC_svn/WARNINGS
+
+# DA repository
+set::url::da                 svn://fcm5/DA_svn/DA
+
+# ENS repository
+set::url::ens                svn://fcm9/ENS_svn/ENS
+
+# ERSEM repository
+set::url::ersem              svn://fcm3/ERSEM_svn/ERSEM
+set::url::ersem_pml          svn://fcm3/ERSEM_svn/ERSEM_PML
+
+# FCM repository
+set::url::fcm                svn://fcm1/FCM_svn/FCM
+set::url::fcm_admin          svn://fcm1/FCM_svn/Admin
+
+
+# FLUME repository
+set::url::flume_metadata     svn://fcm2/FLUME_svn/metadata
+set::url::flume_framework    svn://fcm2/FLUME_svn/framework
+set::url::flume_models       svn://fcm2/FLUME_svn/models
+set::url::flume_jobs         svn://fcm2/FLUME_svn/jobs
+
+# FORMOST repository
+set::url::formost_local      svn://fcm9/FORMOST_svn/FORMOST_LOCAL
+set::url::formost_remote     svn://fcm9/FORMOST_svn/FORMOST_REMOTE
+
+# GEN repository
+set::url::gen                svn://fcm1/GEN_svn/GEN
+
+# GS repository
+set::url::gs                 svn://fcm9/GS_svn/GS
+
+# HadGOA repository
+set::url::hadgoa             svn://fcm9/HadGOA_svn/HadGOA
+
+# HadISD repository
+set::url::hadisd_gen         svn://fcm9/HadISD_svn/general
+set::url::hadisd_homog       svn://fcm9/HadISD_svn/homogenisation
+set::url::hadisd_qc          svn://fcm9/HadISD_svn/quality_control
+
+# IRIS repository
+set::url::iris               svn://fcm9/IRIS_svn/IRIS
+
+# LEM repository
+set::url::lem                svn://fcm2/LEM_svn/LEM
+
+# LINK repository
+set::url::link               svn://fcm1/LINK_svn/LINK
+
+# MASS_MIG repository
+set::url::mass_mig           svn://fcm9/MASS_MIG_svn/MASS_MIG
+
+# MOOSE repository
+set::url::moose              svn://fcm9/MOOSE_svn/MOOSE
+
+# MOSIG repository
+set::url::mosig              svn://fcm9/MOSIG_svn/MOSIG
+
+# MUMTI repository
+set::url::mumti              svn://fcm1/MUMTI_svn/Project
+
+# NEMO repository
+set::url::nemosys            svn://fcm3/NEMO_svn/NEMOSYS
+set::url::nemovar            svn://fcm3/NEMO_svn/NEMOVAR
+set::url::nemo               svn://fcm3/NEMO_svn/NEMO
+set::url::ioipsl             svn://fcm3/NEMO_svn/IOIPSL
+set::url::ocnasm             svn://fcm3/NEMO_svn/OCNASM
+set::url::nemoukmo           svn://fcm3/NEMO_svn/UKMO
+
+# NWPSAF repository
+
+set::url::meto_1dvar         svn://fcm7/NWPSAF_svn/MetOffice_1DVar		   
+set::url::ssmis_1dvar        svn://fcm7/NWPSAF_svn/ssmis_1DVar		   
+set::url::ssmis_pp           svn://fcm7/NWPSAF_svn/ssmis_PP		   
+
+# NWPWEB repository
+set::url::www_nwp            svn://fcm1/NWPWEB_svn/www_nwp
+
+# obsmon repository
+set::url::obsmon_dc          svn://fcm4/obsmon_svn/DC
+set::url::obsmon_rtm         svn://fcm4/obsmon_svn/RTM
+
+# ODB repository
+set::url::odb                svn://fcm4/ODB_svn/ODB
+
+# OCN repository
+set::url::polcoms            svn://fcm3/OCN_svn/POLCOMS
+
+# OPFC repository
+set::url::opfc               svn://fcm9/OPFC_svn/OPFC
+
+# OPS repository
+set::url::ops                svn://fcm4/OPS_svn/OPS
+set::url::ops_admin          svn://fcm4/OPS_svn/Admin
+set::url::ops_data           svn://fcm4/OPS_svn/Data
+set::url::ops_external       svn://fcm4/OPS_svn/External
+
+# OSTIA repository
+set::url::ostia              svn://fcm3/OSTIA_svn/OSTIA
+
+# PF repository
+set::url::pf                 svn://fcm5/PF_svn/PF
+
+# PostProc repository
+set::url::pp                 svn://fcm9/PostProc_svn/PostProc
+set::url::ppancil            svn://fcm9/PostProc_svn/PostProcAncil
+set::url::ppvssps            svn://fcm9/PostProc_svn/VerificationSSPS
+
+# PRISM repository
+set::url::oasis3             svn://fcm2/PRISM_svn/OASIS3
+set::url::oasis4             svn://fcm2/PRISM_svn/OASIS4
+set::url::prism_ukmo         svn://fcm2/PRISM_svn/PRISM_UKMO
+
+# radarnet repository
+set::url::radarnet4          svn://fcm9/radarnet_svn/radarnet4
+
+# RADSAT repository
+set::url::polar              svn://fcm7/RADSAT_svn/POLAR
+set::url::radsat             svn://fcm7/RADSAT_svn/RADSAT
+
+# ROPP repository
+set::url::ropp_doc           svn://fcm7/ROPP_svn/ropp_doc
+set::url::ropp_src           svn://fcm7/ROPP_svn/ropp_src
+set::url::ropp_test          svn://fcm7/ROPP_svn/ropp_test
+set::url::ropp_web           svn://fcm7/ROPP_svn/ropp_web
+
+# RTTOV repository
+set::url::rttov              svn://fcm7/RTTOV_svn/RTTOV 
+set::url::rttov8             svn://fcm7/RTTOV_svn/RTTOV8
+set::url::rttov9             svn://fcm7/RTTOV_svn/RTTOV9
+
+# SAUtils repository
+set::url::autoscat_global    svn://fcm7/SAUtils_svn/AUTOSCAT_Global
+set::url::autoscat_nae       svn://fcm7/SAUtils_svn/AUTOSCAT_NAE
+set::url::climetop           svn://fcm7/SAUtils_svn/CLIMETOP
+set::url::dataflow           svn://fcm7/SAUtils_svn/DataFlow
+set::url::gpsiwv_mon         svn://fcm7/SAUtils_svn/GPSIWV_Mon
+set::url::gpswv_nrt          svn://fcm7/SAUtils_svn/GPSWV_NRT
+set::url::gpsro_mon          svn://fcm7/SAUtils_svn/GPSRO_Mon
+set::url::iasi_mon           svn://fcm7/SAUtils_svn/IASI_Mon
+set::url::metstrike          svn://fcm7/SAUtils_svn/METSTRIKE
+set::url::scatwind_mon       svn://fcm7/SAUtils_svn/Scatwind_Mon
+
+# SBV repository
+set::url::sbv                svn://fcm6/SBV_svn/SBV
+set::url::sbv_admin          svn://fcm6/SBV_svn/Admin
+
+# SCS repository
+set::url::scs                svn://fcm1/SCS_svn/SCS
+set::url::scs_admin          svn://fcm1/SCS_svn/Admin
+set::url::tik                svn://fcm1/SCS_svn/TIK
+set::url::tt                 svn://fcm1/SCS_svn/TT
+
+# SPS repository
+set::url::sps                svn://fcm7/SPS_svn/SPS
+set::url::tigger             svn://fcm7/SPS_svn/Tigger
+set::url::sps_archive        svn://fcm7/SPS_svn/Archive
+
+# SURF repository
+set::url::surf               svn://fcm8/SURF_svn/SURF
+
+# SWARV repository
+set::url::swarv              svn://fcm9/SWARV_svn/SWARV
+
+# test repository
+set::url::test               svn://fcm1/test_svn/OPS
+
+# tutorial repository
+set::url::tutorial           svn://fcm1/tutorial_svn/tutorial
+
+# THORPEX repository
+set::url::thorpex            svn://fcm9/ENS_svn/ENS
+
+# TRUI repository
+set::url::trui               svn://fcm1/TRUI_svn/TRUI
+
+# UM repository
+set::url::um                 svn://fcm2/UM_svn/UM
+set::url::um_admin           svn://fcm2/UM_svn/Admin
+set::url::gcom               svn://fcm2/UM_svn/GCOM
+
+# UM tutorial repository
+set::url::um_tutorial        svn://fcm2/UM_TUTORIAL_svn/UM
+
+# utils repository
+set::url::app_publications   svn://fcm9/utils_svn/APP_publications
+set::url::asyncios           svn://fcm9/utils_svn/asyncIOS
+set::url::avapps_coldsoak    svn://fcm9/utils_svn/avapps_coldsoak
+set::url::avapps_verCB       svn://fcm9/utils_svn/avapps_verCB
+set::url::crmtest            svn://fcm9/utils_svn/cr_model_testing
+set::url::cr_valnote         svn://fcm9/utils_svn/cr_validation_note
+set::url::fray_utils         svn://fcm9/utils_svn/fray_utils
+set::url::hpss_tests         svn://fcm9/utils_svn/HPSS_tests
+set::url::jules_benchmarking svn://fcm9/utils_svn/jules_benchmarking
+set::url::jules_standalone   svn://fcm9/utils_svn/jules_standalone
+set::url::kid                svn://fcm9/utils_svn/KiD
+set::url::numerical_methods  svn://fcm9/utils_svn/numerical_methods
+set::url::wavefc             svn://fcm9/utils_svn/wave_forecasting
+
+# VAR repository
+set::url::var                svn://fcm5/VAR_svn/VAR
+set::url::var_admin          svn://fcm5/VAR_svn/Admin
+set::url::var_data           svn://fcm5/VAR_svn/Data
+
+# VER repository
+set::url::ver                svn://fcm6/VER_svn/VER
+set::url::ver_admin          svn://fcm6/VER_svn/Admin
+set::url::ver_archive        svn://fcm6/VER_svn/Archive
+
+# VMM repository
+set::url::vmm                svn://fcm9/VMM_svn/VMM
+
+# WW3 repository
+set::url::ww3                svn://fcm3/WW3_svn/WW3
+set::url::ww3_config         svn://fcm3/WW3_svn/WW3CONFIG
+set::url::ww3_utils          svn://fcm3/WW3_svn/WW3UTILS
+
+# EOF
Index: vendors/FCM/etc/fcm_gui.desktop
===================================================================
--- vendors/FCM/etc/fcm_gui.desktop	(revision 9621)
+++ vendors/FCM/etc/fcm_gui.desktop	(revision 9621)
@@ -0,0 +1,13 @@
+[Desktop Entry]
+Comment=
+Exec=fcm gui %f
+Hidden=false
+Icon=wizard
+MimeType=inode/directory
+Name=FCM GUI
+Path=
+Terminal=0
+TerminalOptions=
+Type=Application
+X-KDE-SubstituteUID=false
+X-KDE-Username=
Index: vendors/FCM/lib/Fcm/Base.pm
===================================================================
--- vendors/FCM/lib/Fcm/Base.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Base.pm	(revision 9621)
@@ -0,0 +1,112 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Base
+#
+# DESCRIPTION
+#   This is base class for all FCM OO packages.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Base;
+
+# Standard pragma
+use strict;
+use warnings;
+
+use Fcm::Config;
+
+my @scalar_properties = (
+  'config', # instance of Fcm::Config, configuration setting
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Base->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Base class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self  = {};
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'config') {
+        # Configuration setting of the main program
+        $self->{$name} = Fcm::Config->instance();
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $self->setting (@args); # $self->config->setting
+#   $value = $self->verbose (@args); # $self->config->verbose
+# ------------------------------------------------------------------------------
+
+for my $name (qw/setting verbose/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+    return $self->config->$name (@_);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $self->cfglabel (@args);
+#
+# DESCRIPTION
+#   This is an alias to $self->config->setting ('CFG_LABEL', @args);
+# ------------------------------------------------------------------------------
+
+sub cfglabel {
+  my $self = shift;
+  return $self->setting ('CFG_LABEL', @_);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Build.pm
===================================================================
--- vendors/FCM/lib/Fcm/Build.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Build.pm	(revision 9621)
@@ -0,0 +1,1606 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Build
+#
+# DESCRIPTION
+#   This is the top level class for the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package Fcm::Build;
+use base qw(Fcm::ConfigSystem);
+
+use Carp             qw{croak}                                       ;
+use Cwd              qw{cwd}                                         ;
+use Fcm::BuildSrc                                                    ;
+use Fcm::BuildTask                                                   ;
+use Fcm::Config                                                      ;
+use Fcm::Dest                                                        ;
+use Fcm::CfgLine                                                     ;
+use Fcm::Timer       qw{timestamp_command}                           ;
+use Fcm::Util        qw{expand_tilde run_command touch_file w_report};
+use File::Basename   qw{dirname}                                     ;
+use File::Spec                                                       ;
+use List::Util       qw{first}                                       ;
+use Text::ParseWords qw{shellwords}                                  ;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'name',    # name of this build
+  'target',  # targets of this build
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'srcpkg',      # source packages of this build
+  'dummysrcpkg', # dummy for handling package inheritance with file extension
+);
+
+# List of compare_setting_X methods
+my @compare_setting_methods = (
+  'compare_setting_bld_blockdata', # program executable blockdata dependency
+  'compare_setting_bld_dep',       # custom dependency setting
+  'compare_setting_bld_dep_excl',  # exclude dependency setting
+  'compare_setting_bld_dep_n',     # no dependency check
+  'compare_setting_bld_dep_pp',    # custom PP dependency setting
+  'compare_setting_bld_dep_exe',   # program executable extra dependency
+  'compare_setting_bld_exe_name',  # program executable rename
+  'compare_setting_bld_pp',        # PP flags
+  'compare_setting_infile_ext',    # input file extension
+  'compare_setting_outfile_ext',   # output file extension
+  'compare_setting_tool',          # build tool settings
+);
+
+my $DELIMITER_LIST = $Fcm::Config::DELIMITER_LIST;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Build->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Build class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::ConfigSystem->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  push @{ $self->cfg_methods }, (qw/target source tool dep misc/);
+
+  # Optional prefix in configuration declaration
+  $self->cfg_prefix ($self->setting (qw/CFG_LABEL BDECLARE/));
+
+  # System type
+  $self->type ('bld');
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'target') {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'name') {
+        # Empty string
+        $self->{$name} = '';
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->X ($old_lines);
+#
+# DESCRIPTION
+#   This method compares current settings with those in the cache, where X is
+#   one of @compare_setting_methods.
+#
+#   If setting has changed:
+#   * For bld_blockdata, bld_dep_ext and bld_exe_name, it sets the re-generate
+#     make-rule flag to true.
+#   * For bld_dep_excl, in a standalone build, the method will remove the
+#     dependency cache files for affected sub-packages. It returns an error if
+#     the current build inherits from previous builds.
+#   * For bld_pp, it updates the PP setting for affected sub-packages.
+#   * For infile_ext, in a standalone build, the method will remove all the
+#     sub-package cache files and trigger a re-build by removing most
+#     sub-directories created by the previous build. It returns an error if the
+#     current build inherits from previous builds.
+#   * For outfile_ext, in a standalone build, the method will remove all the
+#     sub-package dependency cache files. It returns an error if the current
+#     build inherits from previous builds.
+#   * For tool, it updates the "flags" files for any changed tools.
+# ------------------------------------------------------------------------------
+
+for my $name (@compare_setting_methods) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $old_lines) = @_;
+
+    (my $prefix = uc ($name)) =~ s/^COMPARE_SETTING_//;
+
+    my ($changed, $new_lines) =
+      $self->compare_setting_in_config ($prefix, $old_lines);
+
+    my $rc = scalar (keys %$changed);
+
+    if ($rc and $old_lines) {
+      $self->srcpkg ('')->is_updated (1);
+
+      if ($name =~ /^compare_setting_bld_dep(?:_excl|_n|_pp)?$/) {
+        # Mark affected packages as being updated
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->is_in_package ($key);
+            $pkg->is_updated (1);
+          }
+        }
+
+      } elsif ($name eq 'compare_setting_bld_pp') {
+        # Mark affected packages as being updated
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->is_in_package ($key);
+            next unless $self->srcpkg ($key)->is_type_any (
+              keys %{ $self->setting ('BLD_TYPE_DEP_PP') }
+            ); # Is a type requiring pre-processing
+
+            $pkg->is_updated (1);
+          }
+        }
+
+      } elsif ($name eq 'compare_setting_infile_ext') {
+        # Re-set input file type if necessary
+        for my $key (keys %$changed) {
+          for my $pkg (values %{ $self->srcpkg }) {
+            next unless $pkg->src and $pkg->ext and $key eq $pkg->ext;
+
+            $pkg->type (undef);
+          }
+        }
+
+        # Mark affected packages as being updated
+        for my $pkg (values %{ $self->srcpkg }) {
+          $pkg->is_updated (1);
+        }
+
+      } elsif ($name eq 'compare_setting_outfile_ext') {
+        # Mark affected packages as being updated
+        for my $pkg (values %{ $self->srcpkg }) {
+          $pkg->is_updated (1);
+        }
+
+      } elsif ($name eq 'compare_setting_tool') {
+        # Update the "flags" files for changed tools
+        for my $name (sort keys %$changed) {
+          my ($tool, @names) = split /__/, $name;
+          my $pkg  = join ('__', @names);
+          my @srcpkgs = $self->srcpkg ($pkg)
+                        ? ($self->srcpkg ($pkg))
+                        : @{ $self->dummysrcpkg ($pkg)->children };
+
+          for my $srcpkg (@srcpkgs) {
+            my $file = File::Spec->catfile (
+              $self->dest->flagsdir, $srcpkg->flagsbase ($tool)
+            );
+            &touch_file ($file) or croak $file, ': cannot update, abort';
+
+            print $file, ': updated', "\n" if $self->verbose > 2;
+          }
+        }
+      }
+    }
+
+    return ($rc, $new_lines);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_dependency ($old_lines, $flag);
+#
+# DESCRIPTION
+#   This method uses the previous settings to determine the dependencies of
+#   current source files.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_dependency {
+  my ($self, $old_lines, $flag) = @_;
+
+  my $prefix = $flag ? 'DEP_PP' : 'DEP';
+  my $method = $flag ? 'ppdep'  : 'dep';
+
+  my $rc = 0;
+  my $new_lines = [];
+
+  # Separate old lines
+  my %old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old{$line->label_from_field (1)} = $line;
+    }
+  }
+
+  # Go through each source to see if the cache is up to date
+  my $count = 0;
+  my %mtime;
+  for my $srcpkg (values %{ $self->srcpkg }) {
+    next unless $srcpkg->cursrc and $srcpkg->type;
+
+    my $key = $srcpkg->pkgname;
+    my $out_of_date = $srcpkg->is_updated;
+
+    # Check modification time of cache and source file if not out of date
+    if (exists $old{$key}) {
+      if (not $out_of_date) {
+        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
+          if not exists ($mtime{$old{$key}->src});
+
+        $out_of_date = 1 if $mtime{$old{$key}->src} < $srcpkg->curmtime;
+      }
+    }
+    else {
+      $out_of_date = 1;
+    }
+
+    if ($out_of_date) {
+      # Re-scan dependency
+      $srcpkg->is_updated(1);
+      my ($source_is_read, $dep_hash_ref) = $srcpkg->get_dep($flag);
+      if ($source_is_read) {
+        $count++;
+      }
+      $srcpkg->$method($dep_hash_ref);
+      $rc = 1;
+    }
+    else {
+      # Use cached dependency
+      my ($progname, %hash) = split (
+        /$Fcm::Config::DELIMITER_PATTERN/, $old{$key}->value
+      );
+      $srcpkg->progname ($progname) if $progname and not $flag;
+      $srcpkg->$method (\%hash);
+    }
+
+    # New lines values: progname[::dependency-name::type][...]
+    my @value = ((defined $srcpkg->progname ? $srcpkg->progname : ''));
+    for my $name (sort keys %{ $srcpkg->$method }) {
+      push @value, $name, $srcpkg->$method ($name);
+    }
+
+    push @$new_lines, Fcm::CfgLine->new (
+      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
+      VALUE => join ($Fcm::Config::DELIMITER, @value),
+    );
+  }
+
+  print 'No. of file', ($count > 1 ? 's' : ''), ' scanned for',
+        ($flag ? ' PP': ''), ' dependency: ', $count, "\n"
+    if $self->verbose and $count;
+
+  return ($rc, $new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_srcpkg ($old_lines);
+#
+# DESCRIPTION
+#   This method uses the previous settings to determine the type of current
+#   source files.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_srcpkg {
+  my ($self, $old_lines) = @_;
+
+  my $prefix = 'SRCPKG';
+
+  # Get relevant items from old lines, stripping out $prefix
+  my %old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old{$line->label_from_field (1)} = $line;
+    }
+  }
+
+  # Check for change, use previous setting if exist
+  my $out_of_date = 0;
+  my %mtime;
+  for my $key (keys %{ $self->srcpkg }) {
+    if (exists $old{$key}) {
+      next unless $self->srcpkg ($key)->cursrc;
+
+      my $type = defined $self->setting ('BLD_TYPE', $key)
+                 ? $self->setting ('BLD_TYPE', $key) : $old{$key}->value;
+
+      $self->srcpkg ($key)->type ($type);
+
+      if ($type ne $old{$key}->value) {
+        $self->srcpkg ($key)->is_updated (1);
+        $out_of_date = 1;
+      }
+
+      if (not $self->srcpkg ($key)->is_updated) {
+        $mtime{$old{$key}->src} = (stat ($old{$key}->src))[9]
+          if not exists ($mtime{$old{$key}->src});
+
+        $self->srcpkg ($key)->is_updated (1)
+          if $mtime{$old{$key}->src} < $self->srcpkg ($key)->curmtime;
+      }
+
+    } else {
+      $self->srcpkg ($key)->is_updated (1);
+      $out_of_date = 1;
+    }
+  }
+
+  # Check for deleted keys
+  for my $key (keys %old) {
+    next if $self->srcpkg ($key);
+
+    $out_of_date = 1;
+  }
+
+  # Return reference to an array of new lines
+  my $new_lines = [];
+  for my $key (keys %{ $self->srcpkg }) {
+    push @$new_lines, Fcm::CfgLine->new (
+      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
+      VALUE => $self->srcpkg ($key)->type,
+    );
+  }
+
+  return ($out_of_date, $new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $new_lines) = $self->compare_setting_target ($old_lines);
+#
+# DESCRIPTION
+#   This method compare the previous target settings with current ones.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_target {
+  my ($self, $old_lines) = @_;
+
+  my $prefix = 'TARGET';
+  my $old;
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      next unless $line->label_starts_with ($prefix);
+      $old = $line->value;
+      last;
+    }
+  }
+
+  my $new = join (' ', sort @{ $self->target });
+
+  return (
+    (defined ($old) ? $old ne $new : 1),
+    [Fcm::CfgLine->new (LABEL => $prefix, VALUE => $new)],
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_fortran_interface_generator ();
+#
+# DESCRIPTION
+#   This method invokes the Fortran interface generator for all Fortran free
+#   format source files. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_fortran_interface_generator {
+  my $self = shift;
+
+  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up build task to generate interface files for all selected Fortran 9x
+  # sources
+  my %task = ();
+  SRC_FILE:
+  for my $srcfile (values %{ $self->srcpkg }) {
+    if (!defined($srcfile->interfacebase())) {
+      next SRC_FILE;
+    }
+    my $target  = $srcfile->interfacebase . $pdoneext;
+
+    $task{$target} = Fcm::BuildTask->new (
+      TARGET     => $target,
+      TARGETPATH => $self->dest->donepath,
+      SRCFILE    => $srcfile,
+      DEPENDENCY => [$srcfile->flagsbase ('GENINTERFACE')],
+      ACTIONTYPE => 'GENINTERFACE',
+    );
+
+    # Set up build tasks for each source file/package flags file for interface
+    # generator tool
+    for my $i (1 .. @{ $srcfile->pkgnames }) {
+      my $target = $srcfile->flagsbase ('GENINTERFACE', -$i);
+      my $depend = $i < @{ $srcfile->pkgnames }
+                   ? $srcfile->flagsbase ('GENINTERFACE', -$i - 1)
+                   : undef;
+
+      $task{$target} = Fcm::BuildTask->new (
+        TARGET     => $target,
+        TARGETPATH => $self->dest->flagspath,
+        DEPENDENCY => [defined ($depend) ? $depend : ()],
+        ACTIONTYPE => 'UPDATE',
+      ) if not exists $task{$target};
+    }
+  }
+
+  # Set up build task to update the flags file for interface generator tool
+  $task{$self->srcpkg ('')->flagsbase ('GENINTERFACE')} = Fcm::BuildTask->new (
+    TARGET     => $self->srcpkg ('')->flagsbase ('GENINTERFACE'),
+    TARGETPATH => $self->dest->flagspath,
+    ACTIONTYPE => 'UPDATE',
+  );
+
+  my $count = 0;
+
+  # Performs task
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'GENINTERFACE';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $count++ if $rc;
+  }
+
+  print 'No. of generated Fortran interface', ($count > 1 ? 's' : ''), ': ',
+        $count, "\n"
+    if $self->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_make (%args);
+#
+# DESCRIPTION
+#   This method invokes the make stage of the build system. It returns true on
+#   success.
+#
+# ARGUMENTS
+#   ARCHIVE - If set to "true", invoke the "archive" mode. Most build files and
+#             directories created by this build will be archived using the
+#             "tar" command.  If not set, the default is not to invoke the
+#             "archive" mode.
+#   JOBS    - Specify number of jobs that can be handled by "make". If set, the
+#             value must be a natural integer. If not set, the default value is
+#             1 (i.e.  run "make" in serial mode).
+#   TARGETS - Specify targets to be built. If set, these targets will be built
+#             instead of the ones specified in the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub invoke_make {
+  my ($self, %args) = @_;
+  $args{TARGETS} ||= ['all'];
+  $args{JOBS}    ||= 1;
+  my @command = (
+    $self->setting(qw/TOOL MAKE/),
+    shellwords($self->setting(qw/TOOL MAKEFLAGS/)),
+    # -f Makefile
+    ($self->setting(qw/TOOL MAKE_FILE/), $self->dest()->bldmakefile()),
+    # -j N
+    ($args{JOBS} ? ($self->setting(qw/TOOL MAKE_JOB/), $args{JOBS}) : ()),
+    # -s
+    ($self->verbose() >= 3 ? $self->setting(qw/TOOL MAKE_SILENT/) : ()),
+    @{$args{TARGETS}}
+  );
+  my $old_cwd = $self->_chdir($self->dest()->rootdir());
+  run_command(
+    \@command, ERROR => 'warn', RC => \my($code), TIME => $self->verbose() >= 3,
+  );
+  $self->_chdir($old_cwd);
+
+  my $rc = !$code;
+  if ($rc && $args{ARCHIVE}) {
+    $rc = $self->dest()->archive();
+  }
+  $rc &&= $self->dest()->create_bldrunenvsh();
+  while (my ($key, $source) = each(%{$self->srcpkg()})) {
+    $rc &&= defined($source->write_lib_dep_excl());
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_pre_process ();
+#
+# DESCRIPTION
+#   This method invokes the pre-process stage of the build system. It
+#   returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_pre_process {
+  my $self = shift;
+   
+  # Check whether pre-processing is necessary
+  my $invoke = 0;
+  for (values %{ $self->srcpkg }) {
+    next unless $_->get_setting ('BLD_PP');
+    $invoke = 1;
+    last;
+  }
+  return 1 unless $invoke;
+
+  # Scan header dependency
+  my $rc = $self->compare_setting (
+    METHOD_LIST => ['compare_setting_dependency'],
+    METHOD_ARGS => ['BLD_TYPE_DEP_PP'],
+    CACHEBASE   => $self->setting ('CACHE_DEP_PP'),
+  );
+
+  return $rc if not $rc;
+
+  my %task     = ();
+  my $pdoneext = $self->setting (qw/OUTFILE_EXT PDONE/);
+
+  # Set up tasks for each source file
+  for my $srcfile (values %{ $self->srcpkg }) {
+    if ($srcfile->is_type_all (qw/CPP INCLUDE/)) {
+      # Set up a copy build task for each include file
+      $task{$srcfile->base} = Fcm::BuildTask->new (
+        TARGET     => $srcfile->base,
+        TARGETPATH => $self->dest->incpath,
+        SRCFILE    => $srcfile,
+        DEPENDENCY => [keys %{ $srcfile->ppdep }],
+        ACTIONTYPE => 'COPY',
+      );
+
+    } elsif ($srcfile->lang ('TOOL_SRC_PP')) {
+      next unless $srcfile->get_setting ('BLD_PP');
+
+      # Set up a PP build task for each source file
+      my $target = $srcfile->base . $pdoneext;
+
+      # Issue warning for duplicated tasks
+      if (exists $task{$target}) {
+        w_report 'WARNING: ', $target, ': unable to create task for: ',
+                 $srcfile->src, ': task already exists for: ',
+                 $task{$target}->srcfile->src;
+        next;
+      }
+
+      $task{$target} = Fcm::BuildTask->new (
+        TARGET     => $target,
+        TARGETPATH => $self->dest->donepath,
+        SRCFILE    => $srcfile,
+        DEPENDENCY => [$srcfile->flagsbase ('PPKEYS'), keys %{ $srcfile->ppdep }],
+        ACTIONTYPE => 'PP',
+      );
+
+      # Set up update ppkeys/flags build tasks for each source file/package
+      my $ppkeys = $self->setting (
+        'TOOL_SRC_PP', $srcfile->lang ('TOOL_SRC_PP'), 'PPKEYS'
+      );
+
+      for my $i (1 .. @{ $srcfile->pkgnames }) {
+        my $target = $srcfile->flagsbase ($ppkeys, -$i);
+        my $depend = $i < @{ $srcfile->pkgnames }
+                     ? $srcfile->flagsbase ($ppkeys, -$i - 1)
+                     : undef;
+
+        $task{$target} = Fcm::BuildTask->new (
+          TARGET     => $target,
+          TARGETPATH => $self->dest->flagspath,
+          DEPENDENCY => [defined ($depend) ? $depend : ()],
+          ACTIONTYPE => 'UPDATE',
+        ) if not exists $task{$target};
+      }
+    }
+  }
+
+  # Set up update global ppkeys build tasks
+  for my $lang (keys %{ $self->setting ('TOOL_SRC_PP') }) {
+    my $target = $self->srcpkg ('')->flagsbase (
+      $self->setting ('TOOL_SRC_PP', $lang, 'PPKEYS')
+    );
+
+    $task{$target} = Fcm::BuildTask->new (
+      TARGET     => $target,
+      TARGETPATH => $self->dest->flagspath,
+      ACTIONTYPE => 'UPDATE',
+    );
+  }
+
+  # Build all PP tasks
+  my $count = 0;
+  for my $task (values %task) {
+    next unless $task->actiontype eq 'PP';
+
+    my $rc = $task->action (TASKLIST => \%task);
+    $task->srcfile->is_updated ($rc);
+    $count++ if $rc;
+  }
+
+  print 'No. of pre-processed file', ($count > 1 ? 's' : ''), ': ', $count, "\n"
+    if $self->verbose and $count;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_scan_dependency ();
+#
+# DESCRIPTION
+#   This method invokes the scan dependency stage of the build system. It
+#   returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_scan_dependency {
+  my $self = shift;
+
+  # Scan/retrieve dependency
+  # ----------------------------------------------------------------------------
+  my $rc = $self->compare_setting (
+    METHOD_LIST => ['compare_setting_dependency'],
+    CACHEBASE   => $self->setting ('CACHE_DEP'),
+  );
+
+  # Check whether make file is out of date
+  # ----------------------------------------------------------------------------
+  my $out_of_date = not -r $self->dest->bldmakefile;
+
+  if ($rc and not $out_of_date) {
+    for (qw/CACHE CACHE_DEP/) {
+      my $cache_mtime = (stat (File::Spec->catfile (
+        $self->dest->cachedir, $self->setting ($_),
+      )))[9];
+      my $mfile_mtime = (stat ($self->dest->bldmakefile))[9];
+
+      next if not defined $cache_mtime;
+      next if $cache_mtime < $mfile_mtime;
+      $out_of_date = 1;
+      last;
+    }
+  }
+
+  if ($rc and not $out_of_date) {
+    for (values %{ $self->srcpkg }) {
+      next unless $_->is_updated;
+      $out_of_date = 1;
+      last;
+    }
+  }
+
+  if ($rc and $out_of_date) {
+    # Write Makefile
+    # --------------------------------------------------------------------------
+    # Register non-word package name
+    my $unusual = 0;
+    for my $key (sort keys %{ $self->srcpkg }) {
+      next if $self->srcpkg ($key)->src;
+      next if $key =~ /^\w*$/;
+
+      $self->setting (
+        ['FCM_PCK_OBJECTS', $key], 'FCM_PCK_OBJECTS' . $unusual++,
+      );
+    }
+
+    # Write different parts in the Makefile
+    my $makefile = '# Automatic Makefile' . "\n\n";
+    $makefile .= 'FCM_BLD_NAME = ' . $self->name . "\n" if $self->name;
+    $makefile .= 'FCM_BLD_CFG = ' . $self->cfg->actual_src . "\n";
+    $makefile .= 'export FCM_VERBOSE ?= ' . $self->verbose . "\n\n";
+    $makefile .= $self->dest->write_rules;
+    $makefile .= $self->_write_makefile_perl5lib;
+    $makefile .= $self->_write_makefile_tool;
+    $makefile .= $self->_write_makefile_vpath;
+    $makefile .= $self->_write_makefile_target;
+
+    # Write rules for each source package
+    # Ensure that container packages come before files - this allows $(OBJECTS)
+    # and its dependent variables to expand correctly
+    my @srcpkg = sort {
+      if ($self->srcpkg ($a)->libbase and $self->srcpkg ($b)->libbase) {
+        $b cmp $a;
+
+      } elsif ($self->srcpkg ($a)->libbase) {
+        -1;
+
+      } elsif ($self->srcpkg ($b)->libbase) {
+        1;
+
+      } else {
+        $a cmp $b;
+      }
+    } keys %{ $self->srcpkg };
+
+    for (@srcpkg) {
+      $makefile .= $self->srcpkg ($_)->write_rules if $self->srcpkg ($_)->rules;
+    }
+    $makefile .= '# EOF' . "\n";
+
+    # Update Makefile
+    open OUT, '>', $self->dest->bldmakefile
+      or croak $self->dest->bldmakefile, ': cannot open (', $!, '), abort';
+    print OUT $makefile;
+    close OUT
+      or croak $self->dest->bldmakefile, ': cannot close (', $!, '), abort';
+
+    print $self->dest->bldmakefile, ': updated', "\n" if $self->verbose;
+
+    # Check for duplicated targets
+    # --------------------------------------------------------------------------
+    # Get list of types that cannot have duplicated targets
+    my @no_duplicated_target_types = split (
+      /$DELIMITER_LIST/,
+      $self->setting ('BLD_TYPE_NO_DUPLICATED_TARGET'),
+    );
+
+    my %targets;
+    for my $name (sort keys %{ $self->srcpkg }) {
+      next unless $self->srcpkg ($name)->rules;
+
+      for my $key (sort keys %{ $self->srcpkg ($name)->rules }) {
+        if (exists $targets{$key}) {
+          # Duplicated target: warning for most file types
+          my $status = 'WARNING';
+
+          # Duplicated target: error for the following file types
+          if (@no_duplicated_target_types and
+              $self-srcpkg ($name)->is_type_any (@no_duplicated_target_types) and
+              $targets{$key}->is_type_any (@no_duplicated_target_types)) {
+            $status = 'ERROR';
+            $rc = 0;
+          }
+
+          # Report the warning/error
+          w_report $status, ': ', $key, ': duplicated targets for building:';
+          w_report '       ', $targets{$key}->src;
+          w_report '       ', $self->srcpkg ($name)->src;
+
+        } else {
+          $targets{$key} = $self->srcpkg ($name);
+        }
+      }
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_setup_build ();
+#
+# DESCRIPTION
+#   This method invokes the setup_build stage of the build system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_setup_build {
+  my $self = shift;
+
+  my $rc = 1;
+
+  # Extract archived sub-directories if necessary
+  $rc = $self->dest->dearchive if $rc;
+
+  # Compare cache
+  $rc = $self->compare_setting (METHOD_LIST => [
+    'compare_setting_target', # targets
+    'compare_setting_srcpkg', # source package type
+    @compare_setting_methods,
+  ]) if $rc;
+
+  # Set up runtime dependency scan patterns
+  my %dep_pattern = %{ $self->setting ('BLD_DEP_PATTERN') };
+  for my $key (keys %dep_pattern) {
+    my $pattern = $dep_pattern{$key};
+
+    while ($pattern =~ /##([\w:]+)##/g) {
+      my $match = $1;
+      my $val   = $self->setting (split (/$Fcm::Config::DELIMITER/, $match));
+
+      last unless defined $val;
+      $val =~ s/\./\\./;
+
+      $pattern =~ s/##$match##/$val/;
+    }
+
+    $self->setting (['BLD_DEP_PATTERN', $key], $pattern)
+      unless $pattern eq $dep_pattern{$key};
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system (%args);
+#
+# DESCRIPTION
+#   This method invokes the build system. It returns true on success. See also
+#   the header for invoke_make for further information on arguments.
+#
+# ARGUMENTS
+#   STAGE - If set, it should be an integer number or a recognised keyword or
+#           abbreviation. If set, the build is performed up to the named stage.
+#           If not set, the default is to perform all stages of the build.
+#           Allowed values are:
+#             1, setup or s
+#             2, pre_process or pp
+#             3, generate_dependency or gd
+#             4, generate_interface or gi
+#             5, all, a, make or m
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+  my %args = @_;
+
+  # Parse arguments
+  # ----------------------------------------------------------------------------
+  # Default: run all 5 stages
+  my $stage = (exists $args{STAGE} and $args{STAGE}) ? $args{STAGE} : 5;
+
+  # Resolve named stages
+  if ($stage !~ /^\d$/) {
+    my %stagenames = (
+      'S(?:ETUP)?'                      => 1,
+      'P(?:RE)?_?P(?:ROCESS)?'          => 2,
+      'G(?:ENERATE)?_?D(?:ENPENDENCY)?' => 3,
+      'G(?:ENERATE)?_?I(?:NTERFACE)?'   => 4,
+      '(?:A(?:LL)|M(?:AKE)?)'           => 5,
+    );
+
+    # Does it match a recognised stage?
+    for my $name (keys %stagenames) {
+      next unless $stage =~ /$name/i;
+
+      $stage = $stagenames{$name};
+      last;
+    }
+
+    # Specified stage name not recognised, default to 5
+    if ($stage !~ /^\d$/) {
+      w_report 'WARNING: ', $stage, ': invalid build stage, default to 5.';
+      $stage = 5;
+    }
+  }
+
+  # Run the method associated with each stage
+  # ----------------------------------------------------------------------------
+  my $rc = 1;
+
+  my @stages = (
+    ['Setup build'               , 'invoke_setup_build'],
+    ['Pre-process'               , 'invoke_pre_process'],
+    ['Scan dependency'           , 'invoke_scan_dependency'],
+    ['Generate Fortran interface', 'invoke_fortran_interface_generator'],
+    ['Make'                      , 'invoke_make'],
+  );
+
+  for my $i (1 .. 5) {
+    last if (not $rc) or $i > $stage;
+
+    my ($name, $method) = @{ $stages[$i - 1] };
+    $rc = $self->invoke_stage ($name, $method, %args) if $rc and $stage >= $i;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dep (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the dependency settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dep {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  # EXCL_DEP, EXE_DEP and BLOCKDATA declarations
+  # ----------------------------------------------------------------------------
+  for my $name (qw/BLD_BLOCKDATA BLD_DEP BLD_DEP_EXCL BLD_DEP_EXE/) {
+    for my $line (grep {$_->slabel_starts_with_cfg ($name)} @$cfg_lines) {
+      # Separate label into a list, delimited by double-colon, remove 1st field
+      my @flds = $line->slabel_fields;
+      shift @flds;
+
+      if ($name =~ /^(?:BLD_DEP|BLD_DEP_EXCL|BLD_DEP_PP)$/) {
+        # BLD_DEP_*: label fields may contain sub-package
+        my $pk = @flds ? join ('__', @flds) : '';
+
+        # Check whether sub-package is valid
+        if ($pk and not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
+          $line->error ($line->label . ': invalid sub-package in declaration.');
+          $rc = 0;
+          next;
+        }
+
+        # Setting is stored in an array reference
+        $self->setting ([$name, $pk], [])
+          if not defined $self->setting ($name, $pk);
+
+        # Add current declaration to the array if necessary
+        my $list  = $self->setting ($name, $pk);
+        my $value = $name eq 'BLD_DEP_EXCL' ? uc ($line->value) : $line->value;
+        push @$list, $value if not grep {$_ eq $value} @$list;
+
+      } else {
+        # EXE_DEP and BLOCKDATA: label field may be an executable target
+        my $target = @flds ? $flds[0] : '';
+
+        # The value contains a list of objects and/or sub-package names
+        my @deps   = split /\s+/, $line->value;
+
+        if (not @deps) {
+          if ($name eq 'BLD_BLOCKDATA') {
+            # The objects containing a BLOCKDATA program unit must be declared
+            $line->error ($line->label . ': value not set.');
+            $rc = 0;
+            next;
+
+          } else {
+            # If $value is a null string, target(s) depends on all objects
+            push @deps, '';
+          }
+        }
+
+        for my $dep (@deps) {
+          $dep =~ s/$Fcm::Config::DELIMITER_PATTERN/__/g;
+        }
+
+        $self->setting ([$name, $target], join (' ', sort @deps));
+      }
+
+      $line->parsed (1);
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dest (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the build destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dest {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = $self->SUPER::parse_cfg_dest ($cfg_lines);
+
+  # Set up search paths
+  for my $name (@Fcm::Dest::paths) {
+    (my $label = uc ($name)) =~ s/PATH//;
+
+    $self->setting (['PATH', $label], $self->dest->$name);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_misc (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses misc build settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_misc {
+    my ($self, $cfg_lines_ref) = @_;
+    my $rc = 1;
+    my %item_of = (
+        BLD_DEP_N    => [\&_parse_cfg_misc_dep_n   , 1   ], # boolean
+        BLD_EXE_NAME => [\&_parse_cfg_misc_exe_name      ],
+        BLD_LIB      => [\&_parse_cfg_misc_dep_n         ],
+        BLD_PP       => [\&_parse_cfg_misc_dep_n   , 1   ], # boolean
+        BLD_TYPE     => [\&_parse_cfg_misc_dep_n         ],
+        INFILE_EXT   => [\&_parse_cfg_misc_file_ext, 0, 1], # uc($value)
+        OUTFILE_EXT  => [\&_parse_cfg_misc_file_ext, 1, 0], # uc($ns)
+    );
+    while (my ($key, $item) = each(%item_of)) {
+        my ($handler, @extra_arguments) = @{$item};
+        for my $line (@{$cfg_lines_ref}) {
+            if ($line->slabel_starts_with_cfg($key)) {
+                if ($handler->($self, $key, $line, @extra_arguments)) {
+                    $line->parsed(1);
+                }
+                else {
+                    $rc = 0;
+                }
+            }
+        }
+    }
+    return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of BLD_EXE_NAME or similar.
+sub _parse_cfg_misc_exe_name {
+    my ($self, $key, $line) = @_;
+    my ($prefix, $name, @fields) = $line->slabel_fields();
+    if (!$name || @fields) {
+        $line->error(sprintf('%s: expects a single label name field.', $key));
+        return 0;
+    }
+    $self->setting([$key, $name], $line->value());
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of BLD_DEP_N or similar.
+sub _parse_cfg_misc_dep_n {
+    my ($self, $key, $line, $value_is_boolean) = @_;
+    my ($prefix, @fields) = $line->slabel_fields();
+    my $ns = @fields ? join(q{__}, @fields) : q{};
+    if ($ns && !$self->srcpkg($ns) && !$self->dummysrcpkg($ns)) {
+        $line->error($line->label() . ': invalid sub-package in declaration.');
+        return 0;
+    }
+    my @srcpkgs
+        = $self->dummysrcpkg($ns) ? @{$self->dummysrcpkg($ns)->children()}
+        :                           $self->srcpkg($ns)
+        ;
+    my $value = $value_is_boolean ? $line->bvalue() : $line->value();
+    for my $srcpkg (@srcpkgs) {
+        $self->setting([$key, $srcpkg->pkgname()], $value);
+    }
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# parse_cfg_misc: handler of INFILE_EXT/OUTFILE_EXT or similar.
+sub _parse_cfg_misc_file_ext {
+    my ($self, $key, $line, $ns_in_uc, $value_in_uc) = @_;
+    my ($prefix, $ns) = $line->slabel_fields();
+    my $value = $value_in_uc ? uc($line->value()) : $line->value();
+    $self->setting([$key, ($ns_in_uc ? uc($ns) : $ns)], $value);
+    return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_source (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the source package settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_source {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc  = 1;
+  my %src = ();
+
+  # Automatic source directory search?
+  # ----------------------------------------------------------------------------
+  my $search = 1;
+
+  for my $line (grep {$_->slabel_starts_with_cfg ('SEARCH_SRC')} @$cfg_lines) {
+    $search = $line->bvalue;
+    $line->parsed (1);
+  }
+
+  # Search src/ sub-directory if necessary
+  %src = %{ $self->dest->get_source_files } if $search;
+
+  # SRC declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('FILE')} @$cfg_lines) {
+    # Expand ~ notation and path relative to srcdir of destination
+    my $value = $line->value;
+    $value = File::Spec->rel2abs (&expand_tilde ($value), $self->dest->srcdir);
+
+    if (not -r $value) {
+      $line->error ($value . ': source does not exist or is not readable.');
+      next;
+    }
+
+    # Package name
+    my @names = $line->slabel_fields;
+    shift @names;
+
+    # If package name not set, determine using the path if possible
+    if (not @names) {
+      my $package = $self->dest->get_pkgname_of_path ($value);
+      @names = @$package if defined $package;
+    }
+
+    if (not @names) {
+      $line->error ($self->cfglabel ('FILE') .
+                    ': package not specified/cannot be determined.');
+      next;
+    }
+
+    $src{join ('__', @names)} = $value;
+
+    $line->parsed (1);
+  }
+
+  # For directories, get non-recursive file listing, and add to %src
+  # ----------------------------------------------------------------------------
+  for my $key (keys %src) {
+    next unless -d $src{$key};
+
+    opendir DIR, $src{$key} or die $src{$key}, ': cannot read directory';
+    while (my $base = readdir 'DIR') {
+      next if $base =~ /^\./;
+
+      my $file = File::Spec->catfile ($src{$key}, $base);
+      next unless -f $file and -r $file;
+
+      my $name = join ('__', ($key, $base));
+      $src{$name} = $file unless exists $src{$name};
+    }
+    closedir DIR;
+
+    delete $src{$key};
+  }
+
+  # Set up source packages
+  # ----------------------------------------------------------------------------
+  my %pkg = ();
+  for my $name (keys %src) {
+    $pkg{$name} = Fcm::BuildSrc->new (PKGNAME => $name, SRC => $src{$name});
+  }
+
+  # INHERIT::SRC declarations
+  # ----------------------------------------------------------------------------
+  my %can_inherit = ();
+  for my $line (
+    grep {$_->slabel_starts_with_cfg(qw/INHERIT FILE/)} @{$cfg_lines}
+  ) {
+    my ($key1, $key2, @ns) = $line->slabel_fields();
+    $can_inherit{join('__', @ns)} = $line->bvalue();
+    $line->parsed(1);
+  }
+
+  # Inherit packages, if it is OK to do so
+  for my $inherited_build (reverse(@{$self->inherit()})) {
+    SRCPKG:
+    while (my ($key, $srcpkg) = each(%{$inherited_build->srcpkg()})) {
+      if (exists($pkg{$key}) || !$srcpkg->src()) {
+        next SRCPKG;
+      }
+      my $known_key = first {exists($can_inherit{$_})} @{$srcpkg->pkgnames()};
+      if (defined($known_key) && !$can_inherit{$known_key}) {
+        next SRCPKG;
+      }
+      $pkg{$key} = $srcpkg;
+    }
+  }
+
+  # Get list of intermediate "packages"
+  # ----------------------------------------------------------------------------
+  for my $name (keys %pkg) {
+    # Name of current package
+    my @names = split /__/, $name;
+
+    my $cur = $name;
+
+    while ($cur) {
+      # Name of parent package
+      pop @names;
+      my $parent = @names ? join ('__', @names) : '';
+
+      # If parent package does not exist, create it
+      $pkg{$parent} = Fcm::BuildSrc->new (PKGNAME => $parent)
+        unless exists $pkg{$parent};
+
+      # Current package is a child of the parent package
+      push @{ $pkg{$parent}->children }, $pkg{$cur}
+        unless grep {$_->pkgname eq $cur} @{ $pkg{$parent}->children };
+
+      # Go up a package
+      $cur = $parent;
+    }
+  }
+
+  $self->srcpkg (\%pkg);
+
+  # Dummy: e.g. "foo/bar/baz.egg" belongs to the "foo/bar/baz" dummy.
+  # ----------------------------------------------------------------------------
+  for my $name (keys %pkg) {
+    (my $dname = $name) =~ s/\.\w+$//;
+    next if $dname eq $name;
+    next if $self->srcpkg ($dname);
+
+    $self->dummysrcpkg ($dname, Fcm::BuildSrc->new (PKGNAME => $dname))
+      unless $self->dummysrcpkg ($dname);
+    push @{ $self->dummysrcpkg ($dname)->children }, $pkg{$name};
+  }
+
+  # Make sure a package is defined
+  # ----------------------------------------------------------------------------
+  if (not %{$self->srcpkg}) {
+    w_report 'ERROR: ', $self->cfg->actual_src, ': no source file to build.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_target (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the target settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_target {
+  my ($self, $cfg_lines) = @_;
+
+  # NAME declaraions
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('NAME')} @$cfg_lines) {
+    $self->name ($line->value);
+    $line->parsed (1);
+  }
+
+  # TARGET declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('TARGET')} @$cfg_lines) {
+    # Value is a space delimited list
+    push @{ $self->target }, split (/\s+/, $line->value);
+    $line->parsed (1);
+  }
+
+  # INHERIT::TARGET declarations
+  # ----------------------------------------------------------------------------
+  # By default, do not inherit target
+  my $inherit_flag = 0;
+
+  for (grep {$_->slabel_starts_with_cfg (qw/INHERIT TARGET/)} @$cfg_lines) {
+    $inherit_flag = $_->bvalue;
+    $_->parsed (1);
+  }
+
+  # Inherit targets from inherited build, if $inherit_flag is set to true
+  # ----------------------------------------------------------------------------
+  if ($inherit_flag) {
+    for my $use (reverse @{ $self->inherit }) {
+      unshift @{ $self->target }, @{ $use->target };
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_tool (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the tool settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_tool {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  my %tools         = %{ $self->setting ('TOOL') };
+  my @package_tools = split(/$DELIMITER_LIST/, $self->setting('TOOL_PACKAGE'));
+
+  # TOOL declaration
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('TOOL')} @$cfg_lines) {
+    # Separate label into a list, delimited by double-colon, remove TOOL
+    my @flds = $line->slabel_fields;
+    shift @flds;
+
+    # Check that there is a field after TOOL
+    if (not @flds) {
+      $line->error ('TOOL: not followed by a valid label.');
+      $rc = 0;
+      next;
+    }
+
+    # The first field is the tool iteself, identified in uppercase
+    $flds[0] = uc ($flds[0]);
+
+    # Check that the tool is recognised
+    if (not exists $tools{$flds[0]}) {
+      $line->error ($flds[0] . ': not a valid TOOL.');
+      $rc = 0;
+      next;
+    }
+
+    # Check sub-package declaration
+    if (@flds > 1 and not grep {$_ eq $flds[0]} @package_tools) {
+      $line->error ($flds[0] . ': sub-package not accepted with this TOOL.');
+      $rc = 0;
+      next;
+    }
+
+    # Name of declared package
+    my $pk = join ('__', @flds[1 .. $#flds]);
+
+    # Check whether package exists
+    if (not ($self->srcpkg ($pk) or $self->dummysrcpkg ($pk))) {
+      $line->error ($line->label . ': invalid sub-package in declaration.');
+      $rc = 0;
+      next;
+    }
+
+    $self->setting (['TOOL', join ('__', @flds)], $line->value);
+    $line->parsed (1);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_perl5lib ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining $PERL5LIB.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_perl5lib {
+  my $self = shift;
+
+  my $classpath = File::Spec->catfile (split (/::/, ref ($self))) . '.pm';
+
+  my $libdir  = dirname (dirname ($INC{$classpath}));
+  my @libpath = split (/:/, (exists $ENV{PERL5LIB} ? $ENV{PERL5LIB} : ''));
+
+  my $string = ((grep {$_ eq $libdir} @libpath)
+                ? ''
+                : 'export PERL5LIB := ' . $libdir .
+                  (exists $ENV{PERL5LIB} ? ':$(PERL5LIB)' : '') . "\n\n");
+
+  return $string;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_target ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining the default targets.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_target {
+  my $self = shift;
+
+  # Targets of the build
+  # ----------------------------------------------------------------------------
+  my @targets = @{ $self->target };
+  if (not @targets) {
+    # Build targets not specified by user, default to building all main programs
+    my @programs = ();
+
+    # Get all main programs from all packages
+    for my $pkg (values %{ $self->srcpkg }) {
+      push @programs, $pkg->exebase if $pkg->exebase;
+    }
+
+    @programs = sort (@programs);
+
+    if (@programs) {
+      # Build main programs, if there are any
+      @targets = @programs;
+
+    } else {
+      # No main program in source tree, build the default library
+      @targets = ($self->srcpkg ('')->libbase);
+    }
+  }
+
+  my $return = 'FCM_BLD_TARGETS = ' . join (' ', @targets) . "\n\n";
+
+  # Default targets
+  $return .= '.PHONY : all' . "\n\n";
+  $return .= 'all : $(FCM_BLD_TARGETS)' . "\n\n";
+
+  # Targets for copy dummy
+  $return .= sprintf("%s:\n\ttouch \$@\n\n", $self->setting(qw/BLD_CPDUMMY/));
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_tool ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining the build tools.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_tool {
+  my $self = shift;
+
+  # List of build tools
+  my $tool = $self->setting ('TOOL');
+
+  # List of tools local to FCM, (will not be exported)
+  my %localtool = map {($_, 1)} split ( # map into a hash table
+    /$DELIMITER_LIST/, $self->setting ('TOOL_LOCAL'),
+  );
+
+  # Export required tools
+  my $count = 0;
+  my $return = '';
+  for my $name (sort keys %$tool) {
+    # Ignore local tools
+    next if exists $localtool{(split (/__/, $name))[0]};
+
+    if ($name =~ /^\w+$/) {
+      # Tools with normal name, just export it as an environment variable
+      $return .= 'export ' . $name . ' = ' . $tool->{$name} . "\n";
+
+    } else {
+      # Tools with unusual characters, export using a label/value pair
+      $return .= 'export FCM_UNUSUAL_TOOL_LABEL' . $count . ' = ' . $name . "\n";
+      $return .= 'export FCM_UNUSUAL_TOOL_VALUE' . $count . ' = ' .
+                 $tool->{$name} . "\n";
+      $count++;
+    }
+  }
+
+  $return .= "\n";
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_write_makefile_vpath ();
+#
+# DESCRIPTION
+#   This method returns a makefile $string for defining vpath directives.
+# ------------------------------------------------------------------------------
+
+sub _write_makefile_vpath {
+  my $self = shift();
+  my $FMT = 'vpath %%%s $(FCM_%sPATH)';
+  my %SETTING_OF = %{$self->setting('BLD_VPATH')};
+  my %EXT_OF = %{$self->setting('OUTFILE_EXT')};
+  # Note: each setting can be either an empty string or a comma-separated list
+  # of output file extension keys.
+  join(
+    "\n",
+    (
+      map
+      {
+        my $key = $_;
+        my @types = split(qr{$DELIMITER_LIST}msx, $SETTING_OF{$key});
+          @types ? (map {sprintf($FMT, $EXT_OF{$_}, $key)} sort @types)
+        :          sprintf($FMT, q{}, $key)
+        ;
+      }
+      sort keys(%SETTING_OF)
+    ),
+  ) . "\n\n";
+}
+
+# Wraps chdir. Returns the old working directory.
+sub _chdir {
+  my ($self, $path) = @_;
+  if ($self->verbose() >= 3) {
+    printf("cd %s\n", $path);
+  }
+  my $old_cwd = cwd();
+  chdir($path) || croak(sprintf("%s: cannot change directory ($!)\n", $path));
+  $old_cwd;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Build/Fortran.pm
===================================================================
--- vendors/FCM/lib/Fcm/Build/Fortran.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Build/Fortran.pm	(revision 9621)
@@ -0,0 +1,536 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+# ------------------------------------------------------------------------------
+package Fcm::Build::Fortran;
+
+use Text::Balanced qw{extract_bracketed extract_delimited};
+
+# Actions of this class
+my %ACTION_OF = (extract_interface => \&_extract_interface);
+
+# Regular expressions
+# Matches a variable attribute
+my $RE_ATTR = qr{
+    allocatable|dimension|external|intent|optional|parameter|pointer|save|target
+}imsx;
+# Matches a name
+my $RE_NAME = qr{[A-Za-z]\w*}imsx;
+# Matches a specification type
+my $RE_SPEC = qr{
+    character|complex|double\s*precision|integer|logical|real|type
+}imsx;
+# Matches the identifier of a program unit that does not have arguments
+my $RE_UNIT_BASE = qr{block\s*data|module|program}imsx;
+# Matches the identifier of a program unit that has arguments
+my $RE_UNIT_CALL = qr{function|subroutine}imsx;
+# Matches the identifier of any program unit
+my $RE_UNIT      = qr{$RE_UNIT_BASE|$RE_UNIT_CALL}msx;
+my %RE = (
+    # A comment line
+    COMMENT     => qr{\A\s*(?:!|\z)}msx,
+    # A trailing comment, capture the expression before the comment
+    COMMENT_END => qr{\A([^'"]*?)\s*!.*\z}msx,
+    # A contination marker, capture the expression before the marker
+    CONT        => qr{\A(.*)&\s*\z}msx,
+    # A contination marker at the beginning of a line, capture the marker and
+    # the expression after the marker
+    CONT_LEAD   => qr{\A(\s*&)(.*)\z}msx,
+    # Capture a variable identifier, removing any type component expression
+    NAME_COMP   => qr{\b($RE_NAME)(?:\s*\%\s*$RE_NAME)*\b}msx,
+    # Matches the first identifier in a line
+    NAME_LEAD   => qr{\A\s*$RE_NAME\s*}msx,
+    # Captures a name identifier after a comma, and the expression after
+    NAME_LIST   => qr{\A(?:.*?)\s*,\s*($RE_NAME)\b(.*)\z}msx,
+    # Captures the next quote character
+    QUOTE       => qr{\A[^'"]*(['"])}msx,
+    # Matches an attribute declaration
+    TYPE_ATTR   => qr{\A\s*($RE_ATTR)\b}msx,
+    # Matches a type declaration
+    TYPE_SPEC   => qr{\A\s*($RE_SPEC)\b}msx,
+    # Captures the expression after one or more program unit attributes
+    UNIT_ATTR   => qr{\A\s*(?:(?:elemental|recursive|pure)\s+)+(.*)\z}imsx,
+    # Captures the identifier and the symbol of a program unit with no arguments
+    UNIT_BASE   => qr{\A\s*($RE_UNIT_BASE)\s+($RE_NAME)\s*\z}imsx,
+    # Captures the identifier and the symbol of a program unit with arguments
+    UNIT_CALL   => qr{\A\s*($RE_UNIT_CALL)\s+($RE_NAME)\b}imsx,
+    # Captures the end of a program unit, its identifier and its symbol
+    UNIT_END    => qr{\A\s*(end)(?:\s+($RE_NAME)(?:\s+($RE_NAME))?)?\s*\z}imsx,
+    # Captures the expression after a program unit type specification
+    UNIT_SPEC   => qr{\A\s*$RE_SPEC\b(.*)\z}imsx,
+);
+
+# Keywords in type declaration statements
+my %TYPE_DECL_KEYWORD_SET = map { ($_, 1) } qw{
+    allocatable
+    dimension
+    in
+    inout
+    intent
+    kind
+    len
+    optional
+    out
+    parameter
+    pointer
+    save
+    target
+};
+
+# Creates and returns an instance of this class.
+sub new {
+    my ($class) = @_;
+    bless(
+        sub {
+            my $key = shift();
+            if (!exists($ACTION_OF{$key})) {
+                return;
+            }
+            $ACTION_OF{$key}->(@_);
+        },
+        $class,
+    );
+}
+
+# Methods.
+for my $key (keys(%ACTION_OF)) {
+    no strict qw{refs};
+    *{$key} = sub { my $self = shift(); $self->($key, @_) };
+}
+
+# Extracts the calling interfaces of top level subroutines and functions from
+# the $handle for reading Fortran sources.
+sub _extract_interface {
+    my ($handle) = @_;
+    map { _present_line($_) } @{_reduce_to_interface(_load($handle))};
+}
+
+# Reads $handle for the next Fortran statement, handling continuations.
+sub _load {
+    my ($handle) = @_;
+    my $ctx = {signature_token_set_of => {}, statements => []};
+    my $state = {
+        in_contains  => undef, # in a "contains" section of a program unit
+        in_interface => undef, # in an "interface" block
+        in_quote     => undef, # in a multi-line quote
+        stack        => [],    # program unit stack
+    };
+    my $NEW_STATEMENT = sub {
+        {   name        => q{}, # statement name, e.g. function, integer, ...
+            lines       => [],  # original lines in the statement
+            line_number => 0,   # line number (start) in the original source
+            symbol      => q{}, # name of a program unit (signature, end)
+            type        => q{}, # e.g. signature, use, type, attr, end
+            value       => q{}, # the actual value of the statement
+        };
+    };
+    my $statement;
+LINE:
+    while (my $line = readline($handle)) {
+        if (!defined($statement)) {
+            $statement = $NEW_STATEMENT->();
+        }
+        my $value = $line;
+        chomp($value);
+        # Pre-processor directives and continuation
+        if (!$statement->{line_number} && index($value, '#') == 0) {
+            $statement->{line_number} = $.;
+            $statement->{name}        = 'cpp';
+        }
+        if ($statement->{name} eq 'cpp') {
+            push(@{$statement->{lines}}, $line);
+            $statement->{value} .= $value;
+            if (rindex($value, '\\') != length($value) - 1) {
+                $statement = undef;
+            }
+            next LINE;
+        }
+        # Normal Fortran
+        if ($value =~ $RE{COMMENT}) {
+            next LINE;
+        }
+        if (!$statement->{line_number}) {
+            $statement->{line_number} = $.;
+        }
+        my ($cont_head, $cont_tail);
+        if ($statement->{line_number} != $.) { # is a continuation
+            ($cont_head, $cont_tail) = $value =~ $RE{CONT_LEAD};
+            if ($cont_head) {
+                $value = $cont_tail;
+            }
+        }
+        # Correctly handle ! and & in quotes
+        my ($head, $tail) = (q{}, $value);
+        if ($state->{in_quote} && index($value, $state->{in_quote}) >= 0) {
+            my $index = index($value, $state->{in_quote});
+            $head = substr($value, 0, $index + 1);
+            $tail
+                = length($value) > $index + 1
+                ? substr($value, $index + 2)
+                : q{};
+            $state->{in_quote} = undef;
+        }
+        if (!$state->{in_quote}) {
+            while ($tail) {
+                if (index($tail, q{!}) >= 0) {
+                    if (!($tail =~ s/$RE{COMMENT_END}/$1/)) {
+                        ($head, $tail, $state->{in_quote})
+                            = _load_extract_quote($head, $tail);
+                    }
+                }
+                else {
+                    while (index($tail, q{'}) > 0
+                        || index($tail, q{"}) > 0)
+                    {
+                        ($head, $tail, $state->{in_quote})
+                            = _load_extract_quote($head, $tail);
+                    }
+                    $head .= $tail;
+                    $tail = q{};
+                }
+            }
+        }
+        $cont_head ||= q{};
+        push(@{$statement->{lines}}, $cont_head . $head . $tail . "\n");
+        $statement->{value} .= $head . $tail;
+        # Process a statement only if it is marked with a continuation
+        if (!($statement->{value} =~ s/$RE{CONT}/$1/)) {
+            $statement->{value} =~ s{\s+\z}{}msx;
+            if (_process($statement, $ctx, $state)) {
+                push(@{$ctx->{statements}}, $statement);
+            }
+            $statement = undef;
+        }
+    }
+    return $ctx;
+}
+
+# Helper, removes a quoted string from $tail.
+sub _load_extract_quote {
+    my ($head, $tail) = @_;
+    my ($extracted, $remainder, $prefix)
+        = extract_delimited($tail, q{'"}, qr{[^'"]*}msx, q{});
+    if ($extracted) {
+        return ($head . $prefix . $extracted, $remainder);
+    }
+    else {
+        my ($quote) = $tail =~ $RE{QUOTE};
+        return ($head . $tail, q{}, $quote);
+    }
+}
+
+# Study statements and put attributes into array $statements
+sub _process {
+    my ($statement, $ctx, $state) = @_;
+    my $name;
+
+    # End Interface
+    if ($state->{in_interface}) {
+        if ($statement->{value} =~ qr{\A\s*end\s*interface\b}imsx) {
+            $state->{in_interface} = 0;
+        }
+        return;
+    }
+
+    # End Program Unit
+    if (@{$state->{stack}} && $statement->{value} =~ qr{\A\s*end\b}imsx) {
+        my ($end, $type, $symbol) = lc($statement->{value}) =~ $RE{UNIT_END};
+        if (!$end) {
+            return;
+        }
+        my ($top_type, $top_symbol) = @{$state->{stack}->[-1]};
+        if (!$type
+            || $top_type eq $type && (!$symbol || $top_symbol eq $symbol))
+        {
+            pop(@{$state->{stack}});
+            if ($state->{in_contains} && !@{$state->{stack}}) {
+                $state->{in_contains} = 0;
+            }
+            if (!$state->{in_contains}) {
+                $statement->{name}   = $top_type;
+                $statement->{symbol} = $top_symbol;
+                $statement->{type}   = 'end';
+                return $statement;
+            }
+        }
+        return;
+    }
+
+    # Interface/Contains
+    ($name) = $statement->{value} =~ qr{\A\s*(contains|interface)\b}imsx;
+    if ($name) {
+        $state->{'in_' . lc($name)} = 1;
+        return;
+    }
+
+    # Program Unit
+    my ($type, $symbol, @tokens) = _process_prog_unit($statement->{value});
+    if ($type) {
+        push(@{$state->{stack}}, [$type, $symbol]);
+        if ($state->{in_contains}) {
+            return;
+        }
+        $statement->{name}   = lc($type);
+        $statement->{type}   = 'signature';
+        $statement->{symbol} = lc($symbol);
+        $ctx->{signature_token_set_of}{$symbol}
+            = {map { (lc($_) => 1) } @tokens};
+        return $statement;
+    }
+    if ($state->{in_contains}) {
+        return;
+    }
+
+    # Use
+    if ($statement->{value} =~ qr{\A\s*(use)\b}imsx) {
+        $statement->{name} = 'use';
+        $statement->{type} = 'use';
+        return $statement;
+    }
+
+    # Type Declarations
+    ($name) = $statement->{value} =~ $RE{TYPE_SPEC};
+    if ($name) {
+        $name =~ s{\s}{}gmsx;
+        $statement->{name} = lc($name);
+        $statement->{type} = 'type';
+        return $statement;
+    }
+
+    # Attribute Statements
+    ($name) = $statement->{value} =~ $RE{TYPE_ATTR};
+    if ($name) {
+        $statement->{name} = $name;
+        $statement->{type} = 'attr';
+        return $statement;
+    }
+}
+
+# Parse a statement for program unit header. Returns a list containing the type,
+# the symbol and the signature tokens of the program unit.
+sub _process_prog_unit {
+    my ($string) = @_;
+    my ($type, $symbol, @args) = (q{}, q{});
+    # Is it a blockdata, module or program?
+    ($type, $symbol) = $string =~ $RE{UNIT_BASE};
+    if ($type) {
+        $type = lc($type);
+        $type =~ s{\s*}{}gmsx;
+        return ($type, $symbol);
+    }
+    # Remove the attribute and type declaration of a procedure
+    $string =~ s/$RE{UNIT_ATTR}/$1/;
+    my ($match) = $string =~ $RE{UNIT_SPEC};
+    if ($match) {
+        $string = $match;
+        extract_bracketed($string);
+    }
+    # Is it a function or subroutine?
+    ($type, $symbol) = lc($string) =~ $RE{UNIT_CALL};
+    if (!$type) {
+        return;
+    }
+    my $extracted = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+
+    # Get signature tokens from SUBROUTINE/FUNCTION
+    if ($extracted) {
+        $extracted =~ s{\s}{}gmsx;
+        @args = split(q{,}, substr($extracted, 1, length($extracted) - 2));
+        if ($type eq 'function') {
+            my $result = extract_bracketed($string, q{()}, qr{[^(]*}msx);
+            if ($result) {
+                $result =~ s{\A\(\s*(.*?)\s*\)\z}{$1}msx; # remove braces
+                push(@args, $result);
+            }
+            else {
+                push(@args, $symbol);
+            }
+        }
+    }
+    return (lc($type), lc($symbol), map { lc($_) } @args);
+}
+
+# Reduces the list of statements to contain only the interface block.
+sub _reduce_to_interface {
+    my ($ctx) = @_;
+    my (%token_set, @interface_statements);
+STATEMENT:
+    for my $statement (reverse(@{$ctx->{statements}})) {
+        if ($statement->{type} eq 'end'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set
+                = %{$ctx->{signature_token_set_of}{$statement->{symbol}}};
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'signature'
+            && grep { $_ eq $statement->{name} } qw{subroutine function})
+        {
+            push(@interface_statements, $statement);
+            %token_set = ();
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'use') {
+            my ($head, $tail)
+                = split(qr{\s*:\s*}msx, lc($statement->{value}), 2);
+            if ($tail) {
+                my @imports = map { [split(qr{\s*=>\s*}msx, $_, 2)] }
+                    split(qr{\s*,\s*}msx, $tail);
+                my @useful_imports
+                    = grep { exists($token_set{$_->[0]}) } @imports;
+                if (!@useful_imports) {
+                    next STATEMENT;
+                }
+                if (@imports != @useful_imports) {
+                    my @token_strings
+                        = map { $_->[0] . ($_->[1] ? ' => ' . $_->[1] : q{}) }
+                        @useful_imports;
+                    my ($last, @rest) = reverse(@token_strings);
+                    my @token_lines
+                        = (reverse(map { $_ . q{,&} } @rest), $last);
+                    push(
+                        @interface_statements,
+                        {   lines => [
+                                sprintf("%s:&\n", $head),
+                                (map { sprintf(" & %s\n", $_) } @token_lines),
+                            ]
+                        },
+                    );
+                    next STATEMENT;
+                }
+            }
+            push(@interface_statements, $statement);
+            next STATEMENT;
+        }
+        if ($statement->{type} eq 'attr') {
+            my ($spec, @tokens) = ($statement->{value} =~ /$RE{NAME_COMP}/g);
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+        if ($statement->{type} eq 'type') {
+            my ($variable_string, $spec_string)
+                = reverse(split('::', lc($statement->{value}), 2));
+            if ($spec_string) {
+                $spec_string =~ s{$RE{NAME_LEAD}}{}msx;
+            }
+            else {
+                # The first expression in the statement is the type + attrib
+                $variable_string =~ s{$RE{NAME_LEAD}}{}msx;
+                $spec_string = extract_bracketed($variable_string, '()',
+                    qr{[\s\*]*}msx);
+            }
+            # Useful tokens are those that comes after a comma
+            my $tail = q{,} . lc($variable_string);
+            my @tokens;
+            while ($tail) {
+                if ($tail =~ qr{\A\s*['"]}msx) {
+                    extract_delimited($tail, q{'"}, qr{\A[^'"]*}msx, q{});
+                }
+                elsif ($tail =~ qr{\A\s*\(}msx) {
+                    extract_bracketed($tail, '()', qr{\A[^(]*}msx);
+                }
+                else {
+                    my $token;
+                    ($token, $tail) = $tail =~ $RE{NAME_LIST};
+                    if ($token && $token_set{$token}) {
+                        @tokens = ($variable_string =~ /$RE{NAME_COMP}/g);
+                        $tail = q{};
+                    }
+                }
+            }
+            if (@tokens && $spec_string) {
+                my @spec_tokens = (lc($spec_string) =~ /$RE{NAME_COMP}/g);
+                push(
+                    @tokens,
+                    (   grep { !exists($TYPE_DECL_KEYWORD_SET{$_}) }
+                            @spec_tokens
+                    ),
+                );
+            }
+            if (grep { exists($token_set{$_}) } @tokens) {
+                for my $token (@tokens) {
+                    $token_set{$token} = 1;
+                }
+                push(@interface_statements, $statement);
+                next STATEMENT;
+            }
+        }
+    }
+    if (!@interface_statements) {
+        return [];
+    }
+    [   {lines => ["interface\n"]},
+        reverse(@interface_statements),
+        {lines => ["end interface\n"]},
+    ];
+}
+
+# Processes and returns the line of the statement.
+sub _present_line {
+    my ($statement) = @_;
+    map {
+        s{\s+}{ }gmsx;      # collapse multiple spaces
+        s{\s+\z}{\n}msx;    # remove trailing spaces
+        $_;
+    } @{$statement->{lines}};
+}
+
+# ------------------------------------------------------------------------------
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Build::Fortran
+
+=head1 SYNOPSIS
+
+    use Fcm::Build::Fortran;
+    my $fortran_util = Fcm::Build::Fortran->new();
+    open(my($handle), '<', $path_to_a_fortran_source_file);
+    print($fortran_util->extract_interface($handle)); # prints interface
+    close($handle);
+
+=head1 DESCRIPTION
+
+A class to analyse Fortran source. Currently, it has a single method to extract
+the calling interfaces of top level subroutines and functions in a Fortran
+source.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->new()
+
+Creates and returns an instance of this class.
+
+=item $instance->extract_interface($handle)
+
+Extracts the calling interfaces of top level subroutines and functions in a
+Fortran source that can be read from $handle. Returns an interface block as a
+list of lines.
+
+=back
+
+=head1 ACKNOWLEDGEMENT
+
+This module is inspired by the logic developed by the European Centre
+for Medium-Range Weather Forecasts (ECMWF).
+
+=head1 COPYRIGHT
+
+(C) Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/BuildSrc.pm
===================================================================
--- vendors/FCM/lib/Fcm/BuildSrc.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/BuildSrc.pm	(revision 9621)
@@ -0,0 +1,1498 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildSrc
+#
+# DESCRIPTION
+#   This is a class to group functionalities of source in a build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+package Fcm::BuildSrc;
+use base qw{Fcm::Base};
+
+use Carp qw{croak};
+use Cwd qw{cwd};
+use Fcm::Build::Fortran;
+use Fcm::CfgFile;
+use Fcm::CfgLine;
+use Fcm::Config;
+use Fcm::Timer qw{timestamp_command};
+use Fcm::Util qw{find_file_in_path run_command};
+use File::Basename qw{basename dirname};
+use File::Spec;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'children',   # list of children packages
+  'is_updated', # is this source (or its associated settings) updated?
+  'mtime',      # modification time of src
+  'ppmtime',    # modification time of ppsrc
+  'ppsrc',      # full path of the pre-processed source
+  'pkgname',    # package name of the source
+  'progname',   # program unit name in the source
+  'src',        # full path of the source
+  'type',       # type of the source
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'dep',   # dependencies
+  'ppdep', # pre-process dependencies
+  'rules', # make rules
+);
+
+# Error message formats
+my %ERR_MESS_OF = (
+  CHDIR       => '%s: cannot change directory (%s), abort',
+  OPEN        => '%s: cannot open (%s), abort',
+  CLOSE_PIPE  => '%s: failed (%d), abort',
+);
+
+# Event message formats and levels
+my %EVENT_SETTING_OF = (
+  CHDIR            => ['%s: change directory'                   , 2],
+  F_INTERFACE_NONE => ['%s: Fortran interface generation is off', 3],
+  GET_DEPENDENCY   => ['%s: %d line(s), %d auto dependency(ies)', 3],
+);
+
+my %RE_OF = (
+  F_PREFIX => qr{
+    (?:
+      (?:ELEMENTAL|PURE(?:\s+RECURSIVE)?|RECURSIVE(?:\s+PURE)?)
+      \s+
+    )?
+  }imsx,
+  F_SPEC => qr{
+    (?:
+      (?:CHARACTER|COMPLEX|DOUBLE\s*PRECISION|INTEGER|LOGICAL|REAL|TYPE)
+      (?: \s* \( .+ \) | \s* \* \d+ \s*)??
+      \s+
+    )?
+  }imsx,
+);
+
+{
+  # Returns a singleton instance of Fcm::Build::Fortran.
+  my $FORTRAN_UTIL;
+  sub _get_fortran_util {
+    $FORTRAN_UTIL ||= Fcm::Build::Fortran->new();
+    return $FORTRAN_UTIL;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::BuildSrc->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildSrc class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless(Fcm::Base->new(%args), $class);
+  for my $key (@scalar_properties, @hash_properties) {
+    $self->{$key}
+      = exists($args{uc($key)}) ? $args{uc($key)}
+      :                           undef
+      ;
+  }
+  $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'ppsrc') {
+        $self->ppmtime (undef);
+
+      } elsif ($name eq 'src') {
+        $self->mtime (undef);
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'children') {
+        # Reference to an empty array
+        $self->{$name} = [];
+        
+      } elsif ($name =~ /^(?:is_cur|pkgname|ppsrc|src)$/) {
+        # Empty string
+        $self->{$name} = '';
+        
+      } elsif ($name eq 'mtime') {
+        # Modification time
+        $self->{$name} = (stat $self->src)[9] if $self->src;
+        
+      } elsif ($name eq 'ppmtime') {
+        # Modification time
+        $self->{$name} = (stat $self->ppsrc)[9] if $self->ppsrc;
+        
+      } elsif ($name eq 'type') {
+        # Attempt to get the type if src is set
+        $self->{$name} = $self->get_type if $self->src;
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    if (not defined $self->{$name}) {
+      if ($name eq 'rules') {
+        $self->{$name} = $self->get_rules;
+
+      } else {
+        $self->{$name} = {};
+      }
+    }
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   This method returns/sets property X, all derived from src, where X is:
+#     base  - (read-only) basename of src
+#     dir   - (read-only) dirname of src
+#     ext   - (read-only) file extension of src
+#     root  - (read-only) basename of src without the file extension
+# ------------------------------------------------------------------------------
+
+sub base {
+  return &basename ($_[0]->src);
+}
+
+# ------------------------------------------------------------------------------
+
+sub dir {
+  return &dirname ($_[0]->src);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ext {
+  return substr $_[0]->base, length ($_[0]->root);
+}
+
+# ------------------------------------------------------------------------------
+
+sub root {
+  (my $root = $_[0]->base) =~ s/\.\w+$//;
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   This method returns/sets property X, all derived from ppsrc, where X is:
+#     ppbase  - (read-only) basename of ppsrc
+#     ppdir   - (read-only) dirname of ppsrc
+#     ppext   - (read-only) file extension of ppsrc
+#     pproot  - (read-only) basename of ppsrc without the file extension
+# ------------------------------------------------------------------------------
+
+sub ppbase {
+  return &basename ($_[0]->ppsrc);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ppdir {
+  return &dirname ($_[0]->ppsrc);
+}
+
+# ------------------------------------------------------------------------------
+
+sub ppext {
+  return substr $_[0]->ppbase, length ($_[0]->pproot);
+}
+
+# ------------------------------------------------------------------------------
+
+sub pproot {
+  (my $root = $_[0]->ppbase) =~ s/\.\w+$//;
+  return $root;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns/sets property X, derived from src or ppsrc, where X is:
+#     curbase  - (read-only) basename of cursrc
+#     curdir   - (read-only) dirname of cursrc
+#     curext   - (read-only) file extension of cursrc
+#     curmtime - (read-only) modification time of cursrc
+#     curroot  - (read-only) basename of cursrc without the file extension
+#     cursrc   - ppsrc or src
+# ------------------------------------------------------------------------------
+
+for my $name (qw/base dir ext mtime root src/) {
+  no strict 'refs';
+
+  my $subname = 'cur' . $name;
+
+  *$subname = sub {
+    my $self = shift;
+    my $method = $self->ppsrc ? 'pp' . $name : $name;
+    return $self->$method (@_);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $base = $obj->X ();
+#
+# DESCRIPTION
+#   This method returns a basename X for the source, where X is:
+#     donebase      - "done" file name
+#     etcbase       - target for copying data files
+#     exebase       - executable name for source containing a main program
+#     interfacebase - Fortran interface file name
+#     libbase       - library file name
+#     objbase       - object name for source containing compilable source
+#   If the source file contains a compilable procedure, this method returns
+#   the name of the object file.
+# ------------------------------------------------------------------------------
+
+sub donebase {
+  my $self   = shift;
+
+  my $return;
+  if ($self->is_type_all ('SOURCE')) {
+    if ($self->objbase and not $self->is_type_all ('PROGRAM')) {
+      $return = ($self->progname ? $self->progname : lc ($self->curroot)) .
+                $self->setting (qw/OUTFILE_EXT DONE/);
+    }
+
+  } elsif ($self->is_type_all ('INCLUDE')) {
+    $return = $self->curbase . $self->setting (qw/OUTFILE_EXT IDONE/);
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub etcbase {
+  my $self = shift;
+
+  my $return = @{ $self->children }
+               ? $self->pkgname . $self->setting (qw/OUTFILE_EXT ETC/)
+               : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub exebase {
+  my $self = shift;
+
+  my $return;
+  if ($self->objbase and $self->is_type_all ('PROGRAM')) {
+    if ($self->setting ('BLD_EXE_NAME', $self->curroot)) {
+      $return = $self->setting ('BLD_EXE_NAME', $self->curroot);
+
+    } else {
+      $return = $self->curroot . $self->setting (qw/OUTFILE_EXT EXE/);
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub interfacebase {
+  my $self = shift();
+  if (
+        uc($self->get_setting(qw/TOOL GENINTERFACE/)) ne 'NONE'
+    &&  $self->progname()
+    &&  $self->is_type_all(qw/SOURCE/)
+    &&  $self->is_type_any(qw/FORTRAN9X FPP9X/)
+    &&  !$self->is_type_any(qw/PROGRAM MODULE BLOCKDATA/)
+  ) {
+    my $flag = lc($self->get_setting(qw/TOOL INTERFACE/));
+    my $ext  = $self->setting(qw/OUTFILE_EXT INTERFACE/);
+
+    return (($flag eq 'program' ? $self->progname() : $self->curroot()) . $ext);
+  }
+  return;
+}
+
+# ------------------------------------------------------------------------------
+
+sub objbase {
+  my $self = shift;
+
+  my $return;
+
+  if ($self->is_type_all ('SOURCE')) {
+    my $ext = $self->setting (qw/OUTFILE_EXT OBJ/);
+
+    if ($self->is_type_any (qw/FORTRAN FPP/)) {
+      $return = lc ($self->progname) . $ext if $self->progname;
+
+    } else {
+      $return = lc ($self->curroot) . $ext;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->flagsbase ($flag, [$index,]);
+#
+# DESCRIPTION
+#   This method returns the property flagsbase (derived from pkgname) the base
+#   name of the flags-file (to indicate changes in a particular build tool) for
+#   $flag, which can have the value:
+#     *FLAGS  - compiler flags flags-file
+#     *PPKEYS - pre-processor keys (i.e. macro definitions) flags-file
+#     LD      - linker flags-file
+#     LDFLAGS - linker flags flags-file
+#   If $index is set, the $index'th element in pkgnames is used for the package
+#   name.
+# ------------------------------------------------------------------------------
+
+sub flagsbase {
+  my ($self, $flag, $index) = @_;
+
+  (my $pkg = $index ? $self->pkgnames->[$index] : $self->pkgname) =~ s/\.\w+$//;
+
+  if ($self->is_type_all ('SOURCE')) {
+    if ($flag eq 'FLAGS' or $flag eq 'PPKEYS' and $self->lang) {
+      my %tool_src = %{ $self->setting ('TOOL_SRC') };
+      $flag = $tool_src{$self->lang}{$flag} ? $tool_src{$self->lang}{$flag} : '';
+    }
+  }
+
+  if ($flag) {
+    return join ('__', ($flag, $pkg ? $pkg : ())) .
+           $self->setting (qw/OUTFILE_EXT FLAGS/);
+
+  } else {
+    return undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->libbase ([$prefix], [$suffix]);
+#
+# DESCRIPTION
+#   This method returns the property libbase (derived from pkgname) the base
+#   name of the library archive. $prefix and $suffix defaults to 'lib' and '.a'
+#   respectively.
+# ------------------------------------------------------------------------------
+
+sub libbase {
+  my ($self, $prefix, $suffix) = @_;
+  $prefix ||= 'lib';
+  $suffix ||= $self->setting(qw/OUTFILE_EXT LIB/);
+  if ($self->src()) { # applies to directories only
+    return;
+  }
+  my $name = $self->setting('BLD_LIB', $self->pkgname());
+  if (!defined($name)) {
+    $name = $self->pkgname();
+  }
+  $prefix . $name . $suffix;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->lang ([$setting]);
+#
+# DESCRIPTION
+#   This method returns the property lang (derived from type) the programming
+#   language name if type matches one supported in the TOOL_SRC setting. If
+#   $setting is specified, use $setting instead of TOOL_SRC.
+# ------------------------------------------------------------------------------
+
+sub lang {
+  my ($self, $setting) = @_;
+
+  my @keys = keys %{ $self->setting ($setting ? $setting : 'TOOL_SRC') };
+
+  my $return = undef;
+  for my $key (@keys) {
+    next unless $self->is_type_all ('SOURCE', $key);
+    $return = $key;
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->pkgnames;
+#
+# DESCRIPTION
+#   This method returns a list of container packages, derived from pkgname:
+# ------------------------------------------------------------------------------
+
+sub pkgnames {
+  my $self = shift;
+
+  my $return = [];
+  if ($self->pkgname) {
+    my @names = split (/__/, $self->pkgname);
+
+    for my $i (0 .. $#names) {
+      push @$return, join ('__', (@names[0 .. $i]));
+    }
+
+    unshift @$return, '';
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %dep = %{$obj->get_dep()};
+#   %dep = %{$obj->get_dep($flag)};
+#
+# DESCRIPTION
+#   This method scans the current source file for dependencies and returns the
+#   dependency hash (keys = dependencies, values = dependency types). If $flag
+#   is specified, the config setting for $flag is used to determine the types of
+#   types. Otherwise, those specified in 'BLD_TYPE_DEP' is used.
+# ------------------------------------------------------------------------------
+
+sub get_dep {
+  my ($self, $flag) = @_;
+  # Work out list of exclude for this file, using its sub-package name
+  my %EXCLUDE_SET = map {($_, 1)} @{$self->get_setting('BLD_DEP_EXCL')};
+  # Determine what dependencies are supported by this known type
+  my %DEP_TYPE_OF = %{$self->setting($flag ? $flag : 'BLD_TYPE_DEP')};
+  my %PATTERN_OF = %{$self->setting('BLD_DEP_PATTERN')};
+  my @dep_types = ();
+  if (!$self->get_setting('BLD_DEP_N')) {
+    DEP_TYPE:
+    while (my ($key, $dep_type_string) = each(%DEP_TYPE_OF)) {
+      # Check if current file is a type of file requiring dependency scan
+      if (!$self->is_type_all($key)) {
+        next DEP_TYPE;
+      }
+      # Get list of dependency type for this file
+      for my $dep_type (split(/$Fcm::Config::DELIMITER/, $dep_type_string)) {
+        if (exists($PATTERN_OF{$dep_type}) && !exists($EXCLUDE_SET{$dep_type})) {
+          push(@dep_types, $dep_type);
+        }
+      }
+    }
+  }
+
+  # Automatic dependencies
+  my %dep_of;
+  my $can_get_symbol # Also scan for program unit name in Fortran source
+      =  !$flag
+      && $self->is_type_all('SOURCE')
+      && $self->is_type_any(qw/FPP FORTRAN/)
+      ;
+  my $has_read_file;
+  if ($can_get_symbol || @dep_types) {
+    my $handle = _open($self->cursrc());
+    LINE:
+    while (my $line = readline($handle)) {
+      chomp($line);
+      if ($line =~ qr{\A \s* \z}msx) { # empty lines
+        next LINE;
+      }
+      if ($can_get_symbol) {
+        my $symbol = _get_dep_symbol($line);
+        if ($symbol) {
+          $self->progname($symbol);
+          $can_get_symbol = 0;
+          next LINE;
+        }
+      }
+      DEP_TYPE:
+      for my $dep_type (@dep_types) {
+        my ($match) = $line =~ /$PATTERN_OF{$dep_type}/i;
+        if (!$match) {
+          next DEP_TYPE;
+        }
+        # $match may contain multiple items delimited by space
+        for my $item (split(qr{\s+}msx, $match)) {
+          my $key = uc($dep_type . $Fcm::Config::DELIMITER . $item);
+          if (!exists($EXCLUDE_SET{$key})) {
+            $dep_of{$item} = $dep_type;
+          }
+        }
+        next LINE;
+      }
+    }
+    $self->_event('GET_DEPENDENCY', $self->pkgname(), $., scalar(keys(%dep_of)));
+    close($handle);
+    $has_read_file = 1;
+  }
+
+  # Manual dependencies
+  my $manual_deps_ref
+      = $self->setting('BLD_DEP' . ($flag ? '_PP' : ''), $self->pkgname());
+  if (defined($manual_deps_ref)) {
+    for (@{$manual_deps_ref}) {
+      my ($dep_type, $item) = split(/$Fcm::Config::DELIMITER/, $_, 2);
+      $dep_of{$item} = $dep_type;
+    }
+  }
+
+  return ($has_read_file, \%dep_of);
+}
+
+# Returns, if possible, the program unit declared in the $line.
+sub _get_dep_symbol {
+  my $line = shift();
+  for my $pattern (
+    qr{\A \s* $RE_OF{F_PREFIX} SUBROUTINE              \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* MODULE (?!\s+PROCEDURE)                  \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* PROGRAM                                  \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* $RE_OF{F_PREFIX} $RE_OF{F_SPEC} FUNCTION \s+ ([A-Za-z]\w*)}imsx,
+    qr{\A \s* BLOCK\s*DATA                             \s+ ([A-Za-z]\w*)}imsx,
+  ) {
+    my ($match) = $line =~ $pattern;
+    if ($match) {
+      return lc($match);
+    }
+  }
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @out = @{ $obj->get_fortran_interface () };
+#
+# DESCRIPTION
+#   This method invokes the Fortran interface block generator to generate
+#   an interface block for the current source file. It returns a reference to
+#   an array containing the lines of the interface block.
+# ------------------------------------------------------------------------------
+
+sub get_fortran_interface {
+  my $self = shift();
+  my %ACTION_OF = (
+    q{}    => \&_get_fortran_interface_by_internal_code,
+    f90aib => \&_get_fortran_interface_by_f90aib,
+    none   => sub {$self->_event('F_INTERFACE_NONE', $self->root()); []},
+  );
+  my $key = lc($self->get_setting(qw/TOOL GENINTERFACE/));
+  if (!$key || !exists($ACTION_OF{$key})) {
+    $key = q{};
+  }
+  $ACTION_OF{$key}->($self->cursrc());
+}
+
+# Generates Fortran interface block using "f90aib".
+sub _get_fortran_interface_by_f90aib {
+  my $path = shift();
+  my $command = sprintf(q{f90aib <'%s' 2>'%s'}, $path, File::Spec->devnull());
+  my $pipe = _open($command, '-|');
+  my @lines = readline($pipe);
+  close($pipe) || croak($ERR_MESS_OF{CLOSE_PIPE}, $command, $?);
+  \@lines;
+}
+
+# Generates Fortran interface block using internal code.
+sub _get_fortran_interface_by_internal_code {
+  my $path = shift();
+  my $handle = _open($path);
+  my @lines = _get_fortran_util()->extract_interface($handle);
+  close($handle);
+  \@lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @out = @{ $obj->get_pre_process () };
+#
+# DESCRIPTION
+#   This method invokes the pre-processor on the source file and returns a
+#   reference to an array containing the lines of the pre-processed source on
+#   success.
+# ------------------------------------------------------------------------------
+
+sub get_pre_process {
+  my $self = shift;
+
+  # Supported source files
+  my $lang = $self->lang ('TOOL_SRC_PP');
+  return unless $lang;
+
+  # List of include directories
+  my @inc = @{ $self->setting (qw/PATH INC/) };
+
+  # Build the pre-processor command according to file type
+  my %tool        = %{ $self->setting ('TOOL') };
+  my %tool_src_pp = %{ $self->setting ('TOOL_SRC_PP', $lang) };
+
+  # The pre-processor command and its options
+  my @command = ($tool{$tool_src_pp{COMMAND}});
+  my @ppflags = split /\s+/, $self->get_setting ('TOOL', $tool_src_pp{FLAGS});
+
+  # List of defined macros, add "-D" in front of each macro
+  my @ppkeys  = split /\s+/, $self->get_setting ('TOOL', $tool_src_pp{PPKEYS});
+  @ppkeys     = map {($tool{$tool_src_pp{DEFINE}} . $_)} @ppkeys;
+
+  # Add "-I" in front of each include directories
+  @inc        = map {($tool{$tool_src_pp{INCLUDE}} . $_)} @inc;
+
+  push @command, (@ppflags, @ppkeys, @inc, $self->base);
+
+  # Change to container directory of source file
+  my $old_cwd = $self->_chdir($self->dir());
+
+  # Execute the command, getting the output lines
+  my $verbose = $self->verbose;
+  my @outlines = &run_command (
+    \@command, METHOD => 'qx', PRINT => $verbose > 1, TIME => $verbose > 2,
+  );
+
+  # Change back to original directory
+  $self->_chdir($old_cwd);
+
+  return \@outlines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rules = %{ $self->get_rules };
+#
+# DESCRIPTION
+#   This method returns a reference to a hash in the following format:
+#     $rules = {
+#       target => {ACTION => action, DEP => [dependencies], ...},
+#       ...    => {...},
+#     };
+#   where the 1st rank keys are the available targets for building this source
+#   file, the second rank keys are ACTION and DEP. The value of ACTION is the
+#   action for building the target, which can be "COMPILE", "LOAD", "TOUCH",
+#   "CP" or "AR". The value of DEP is a refernce to an array containing a list
+#   of dependencies suitable for insertion into the Makefile.
+# ------------------------------------------------------------------------------
+
+sub get_rules {
+  my $self = shift;
+
+  my $rules;
+  my %outfile_ext = %{ $self->setting ('OUTFILE_EXT') };
+
+  if ($self->is_type_all (qw/SOURCE/)) {
+    # Source file
+    # --------------------------------------------------------------------------
+    # Determine whether the language of the source file is supported
+    my %tool_src = %{ $self->setting ('TOOL_SRC') };
+
+    return () unless $self->lang;
+
+    # Compile object
+    # --------------------------------------------------------------------------
+    if ($self->objbase) {
+      # Depends on the source file
+      my @dep = ($self->rule_src);
+
+      # Depends on the compiler flags flags-file
+      my @flags;
+      push @flags, ('FLAGS' )
+        if $self->flagsbase ('FLAGS' );
+      push @flags, ('PPKEYS')
+        if $self->flagsbase ('PPKEYS') and not $self->ppsrc;
+
+      push @dep, $self->flagsbase ($_) for (@flags);
+
+      # Source file dependencies
+      for my $name (sort keys %{ $self->dep }) {
+        # A Fortran 9X module, lower case object file name
+        if ($self->dep ($name) eq 'USE') {
+          (my $root = $name) =~ s/\.\w+$//;
+          push @dep, lc ($root) . $outfile_ext{OBJ};
+
+        # An include file
+        } elsif ($self->dep ($name) =~ /^(?:INC|H|INTERFACE)$/) {
+          push @dep, $name;
+        }
+      }
+
+      $rules->{$self->objbase} = {ACTION => 'COMPILE', DEP => \@dep};
+
+      # Touch flags-files
+      # ------------------------------------------------------------------------
+      for my $flag (@flags) {
+        next unless $self->flagsbase ($flag);
+
+        $rules->{$self->flagsbase ($flag)} = {
+          ACTION => 'TOUCH',
+          DEP    => [
+            $self->flagsbase ($tool_src{$self->lang}{$flag}, -2),
+          ],
+          DEST   => '$(FCM_FLAGSDIR)',
+        };
+      }
+    }
+
+    if ($self->exebase) {
+      # Link into an executable
+      # ------------------------------------------------------------------------
+      my @dep = ();
+      push @dep, $self->objbase               if $self->objbase;
+      push @dep, $self->flagsbase ('LD'     ) if $self->flagsbase ('LD'     );
+      push @dep, $self->flagsbase ('LDFLAGS') if $self->flagsbase ('LDFLAGS');
+
+      # Depends on BLOCKDATA program units, for Fortran programs
+      my %blockdata = %{ $self->setting ('BLD_BLOCKDATA') };
+      my @blkobj    = ();
+
+      if ($self->is_type_any (qw/FPP FORTRAN/) and keys %blockdata) {
+        # List of BLOCKDATA object files
+        if (exists $blockdata{$self->exebase}) {
+          @blkobj = split /\s+/, $blockdata{$self->exebase};
+
+        } elsif (exists $blockdata{''}) {
+          @blkobj = split /\s+/, $blockdata{''};
+        }
+
+        for my $name (@blkobj) {
+          (my $root = $name) =~ s/\.\w+$//;
+          $name = $root . $outfile_ext{OBJ};
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      # Extra executable dependencies
+      my %exe_dep = %{ $self->setting ('BLD_DEP_EXE') };
+      if (keys %exe_dep) {
+        my @exe_deps;
+        if (exists $exe_dep{$self->exebase}) {
+          @exe_deps = split /\s+/, $exe_dep{$self->exebase};
+
+        } elsif (exists $exe_dep{''}) {
+          @exe_deps = $exe_dep{''} ? split (/\s+/, $exe_dep{''}) : ('');
+        }
+
+        my $pattern = '\\' . $outfile_ext{OBJ} . '$';
+
+        for my $name (@exe_deps) {
+          if ($name =~ /$pattern/) {
+            # Extra dependency is an object
+            (my $root = $name) =~ s/\.\w+$//;
+            push @dep, $root . $outfile_ext{DONE};
+
+          } else {
+            # Extra dependency is a sub-package
+            my $var;
+            if ($self->setting ('FCM_PCK_OBJECTS', $name)) {
+              # sub-package name contains unusual characters
+              $var = $self->setting ('FCM_PCK_OBJECTS', $name);
+
+            } else {
+              # sub-package name contains normal characters
+              $var = $name ? join ('__', ('OBJECTS', $name)) : 'OBJECTS';
+            }
+
+            push @dep, '$(' . $var . ')';
+          }
+        }
+      }
+
+      # Source file dependencies
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->exebase} = {
+        ACTION => 'LOAD', DEP => \@dep, BLOCKDATA => \@blkobj,
+      };
+
+      # Touch Linker flags-file
+      # ------------------------------------------------------------------------
+      for my $flag (qw/LD LDFLAGS/) {
+        $rules->{$self->flagsbase ($flag)} = {
+          ACTION => 'TOUCH',
+          DEP    => [$self->flagsbase ($flag, -2)],
+          DEST   => '$(FCM_FLAGSDIR)',
+        };
+      }
+
+    }
+
+    if ($self->donebase) {
+      # Touch done file
+      # ------------------------------------------------------------------------
+      my @dep = ($self->objbase);
+
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->donebase} = {
+        ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+      };
+    }
+    
+    if ($self->interfacebase) {
+      # Interface target
+      # ------------------------------------------------------------------------
+      # Source file dependencies
+      my @dep = ();
+      for my $name (sort keys %{ $self->dep }) {
+        # Depends on Fortran 9X modules
+        push @dep, lc ($name) . $outfile_ext{OBJ}
+          if $self->dep ($name) eq 'USE';
+      }
+
+      $rules->{$self->interfacebase} = {ACTION => '', DEP => \@dep};
+    }
+
+  } elsif ($self->is_type_all ('INCLUDE')) {
+    # Copy include target
+    # --------------------------------------------------------------------------
+    my @dep = ($self->rule_src);
+
+    for my $name (sort keys %{ $self->dep }) {
+      # A Fortran 9X module, lower case object file name
+      if ($self->dep ($name) eq 'USE') {
+        (my $root = $name) =~ s/\.\w+$//;
+        push @dep, lc ($root) . $outfile_ext{OBJ};
+
+      # An include file
+      } elsif ($self->dep ($name) =~ /^(?:INC|H|INTERFACE)$/) {
+        push @dep, $name;
+      }
+    }
+
+    $rules->{$self->curbase} = {
+      ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_INCDIR)',
+    };
+
+    # Touch IDONE file
+    # --------------------------------------------------------------------------
+    if ($self->donebase) {
+      my @dep = ($self->rule_src);
+
+      for my $name (sort keys %{ $self->dep }) {
+        (my $root = $name) =~ s/\.\w+$//;
+
+        # Lowercase name for object dependency
+        $root   = lc ($root) unless $self->dep ($name) =~ /^(?:INC|H)$/;
+
+        # Select "done" file extension
+        if ($self->dep ($name) =~ /^(?:INC|H)$/) {
+          push @dep, $name . $outfile_ext{IDONE};
+
+        } else {
+          push @dep, $root . $outfile_ext{DONE};
+        }
+      }
+
+      $rules->{$self->donebase} = {
+        ACTION => 'TOUCH', DEP => \@dep, DEST => '$(FCM_DONEDIR)',
+      };
+    }
+
+  } elsif ($self->is_type_any (qw/EXE SCRIPT/)) {
+    # Copy executable file
+    # --------------------------------------------------------------------------
+    my @dep = ($self->rule_src);
+
+    # Depends on dummy copy file, if file is an "always build type"
+    push @dep, $self->setting (qw/BLD_CPDUMMY/)
+      if $self->is_type_any (split (
+        /$Fcm::Config::DELIMITER_LIST/, $self->setting ('BLD_TYPE_ALWAYS_BUILD')
+      ));
+
+    # Depends on other executable files
+    for my $name (sort keys %{ $self->dep }) {
+      push @dep, $name if $self->dep ($name) eq 'EXE';
+    }
+
+    $rules->{$self->curbase} = {
+      ACTION => 'CP', DEP => \@dep, DEST => '$(FCM_BINDIR)',
+    };
+
+  } elsif (@{ $self->children }) {
+    # Targets for top level and package flags files and dummy dependencies
+    # --------------------------------------------------------------------------
+    my %tool_src   = %{ $self->setting ('TOOL_SRC') };
+    my %flags_tool = (LD => '', LDFLAGS => '');
+
+    for my $key (keys %tool_src) {
+      $flags_tool{$tool_src{$key}{FLAGS}} = $tool_src{$key}{COMMAND}
+        if exists $tool_src{$key}{FLAGS};
+
+      $flags_tool{$tool_src{$key}{PPKEYS}} = ''
+        if exists $tool_src{$key}{PPKEYS};
+    }
+
+    for my $name (sort keys %flags_tool) {
+      my @dep = $self->pkgname eq '' ? () : $self->flagsbase ($name, -2);
+      push @dep, $self->flagsbase ($flags_tool{$name})
+        if $self->pkgname eq '' and $flags_tool{$name};
+
+      $rules->{$self->flagsbase ($flags_tool{$name})} = {
+        ACTION => 'TOUCH',
+        DEST   => '$(FCM_FLAGSDIR)',
+      } if $self->pkgname eq '' and $flags_tool{$name};
+
+      $rules->{$self->flagsbase ($name)} = {
+        ACTION => 'TOUCH',
+        DEP    => \@dep,
+        DEST   => '$(FCM_FLAGSDIR)',
+      };
+    }
+
+    # Package object and library
+    # --------------------------------------------------------------------------
+    {
+      my @dep;
+      # Add objects from children
+      for my $child (sort {$a->pkgname cmp $b->pkgname} @{ $self->children }) {
+        push @dep, $child->rule_obj_var (1)
+          if $child->libbase and $child->rules ($child->libbase);
+        push @dep, $child->objbase
+          if $child->cursrc and $child->objbase and
+             not $child->is_type_any (qw/PROGRAM BLOCKDATA/);
+      }
+
+      if (@dep) {
+        $rules->{$self->libbase} = {ACTION => 'AR', DEP => \@dep};
+      }
+    }
+
+    # Package data files
+    # --------------------------------------------------------------------------
+    {
+      my @dep;
+      for my $child (@{ $self->children }) {
+        push @dep, $child->rule_src if $child->src and not $child->type;
+      }
+
+      if (@dep) {
+        push @dep, $self->setting (qw/BLD_CPDUMMY/);
+        $rules->{$self->etcbase} = {
+          ACTION => 'CP_DATA', DEP => \@dep, DEST => '$(FCM_ETCDIR)',
+        };
+      }
+    }
+  }
+
+  return $rules;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->get_setting ($setting[, @prefix]);
+#
+# DESCRIPTION
+#   This method gets the correct $setting for the current source by following
+#   its package name. If @prefix is set, get the setting with the given prefix.
+# ------------------------------------------------------------------------------
+
+sub get_setting {
+  my ($self, $setting, @prefix) = @_;
+
+  my $val;
+  for my $name (reverse @{ $self->pkgnames }) {
+    my @names = split /__/, $name;
+    $val = $self->setting ($setting, join ('__', (@prefix, @names)));
+
+    $val = $self->setting ($setting, join ('__', (@prefix, @names)))
+      if (not defined $val) and @names and $names[-1] =~ s/\.[^\.]+$//;
+    last if defined $val;
+  }
+
+  return $val;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $type = $self->get_type();
+#
+# DESCRIPTION
+#   This method determines whether the source is a type known to the
+#   build system. If so, it returns the type flags delimited by "::".
+# ------------------------------------------------------------------------------
+
+sub get_type {
+  my $self = shift();
+  my @IGNORE_LIST
+    = split(/$Fcm::Config::DELIMITER_LIST/, $self->setting('INFILE_IGNORE'));
+  if (grep {$self->curbase() eq $_} @IGNORE_LIST) {
+    return q{};
+  }
+  # User defined
+  my $type = $self->setting('BLD_TYPE', $self->pkgname());
+  # Extension
+  if (!defined($type)) {
+    my $ext = $self->curext() ? substr($self->curext(), 1) : q{};
+    $type = $self->setting('INFILE_EXT', $ext);
+  }
+  # Pattern of name
+  if (!defined($type)) {
+    my %NAME_PATTERN_TO_TYPE_HASH = %{$self->setting('INFILE_PAT')};
+    PATTERN:
+    while (my ($pattern, $value) = each(%NAME_PATTERN_TO_TYPE_HASH)) {
+      if ($self->curbase() =~ $pattern) {
+        $type = $value;
+        last PATTERN;
+      }
+    }
+  }
+  # Pattern of #! line
+  if (!defined($type) && -s $self->cursrc() && -T _) {
+    my $handle = _open($self->cursrc());
+    my $line = readline($handle);
+    close($handle);
+    my %SHEBANG_PATTERN_TO_TYPE_HASH = %{$self->setting('INFILE_TXT')};
+    PATTERN:
+    while (my ($pattern, $value) = each(%SHEBANG_PATTERN_TO_TYPE_HASH)) {
+      if ($line =~ qr{^\#!.*$pattern}msx) {
+        $type = $value;
+        last PATTERN;
+      }
+    }
+  }
+  if (!$type) {
+    return $type;
+  }
+  # Extra type information for selected file types
+  my %EXTRA_FOR = (
+    qr{\b (?:FORTRAN|FPP) \b}msx => \&_get_type_extra_for_fortran,
+    qr{\b C \b}msx               => \&_get_type_extra_for_c,
+  );
+  EXTRA:
+  while (my ($key, $code_ref) = each(%EXTRA_FOR)) {
+    if ($type =~ $key) {
+      my $handle = _open($self->cursrc());
+      LINE:
+      while (my $line = readline($handle)) {
+        my $extra = $code_ref->($line);
+        if ($extra) {
+          $type .= $Fcm::Config::DELIMITER . $extra;
+          last LINE;
+        }
+      }
+      close($handle);
+      last EXTRA;
+    }
+  }
+  return $type;
+}
+
+sub _get_type_extra_for_fortran {
+  my ($match) = $_[0] =~ qr{\A \s* (PROGRAM|MODULE|BLOCK\s*DATA) \b}imsx;
+  if (!$match) {
+    return;
+  }
+  $match =~ s{\s}{}g;
+  uc($match)
+}
+
+sub _get_type_extra_for_c {
+  ($_[0] =~ qr{int\s+main\s*\(}msx) ? 'PROGRAM' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_in_package ($name);
+#
+# DESCRIPTION
+#   This method returns true if current package is in the package $name.
+# ------------------------------------------------------------------------------
+
+sub is_in_package {
+  my ($self, $name) = @_;
+  
+  my $return = 0;
+  for (@{ $self->pkgnames }) {
+    next unless /^$name(?:\.\w+)?$/;
+    $return = 1;
+    last;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_type_all ($arg, ...);
+#   $flag = $obj->is_type_any ($arg, ...);
+#
+# DESCRIPTION
+#   This method returns a flag for the following:
+#     is_type_all - does type match all of the arguments?
+#     is_type_any - does type match any of the arguments?
+# ------------------------------------------------------------------------------
+
+for my $name ('all', 'any') {
+  no strict 'refs';
+
+  my $subname = 'is_type_' . $name;
+
+  *$subname = sub {
+    my ($self, @intypes) = @_;
+
+    my $rc = 0;
+    if ($self->type) {
+      my %types = map {($_, 1)} split /$Fcm::Config::DELIMITER/, $self->type;
+
+      for my $intype (@intypes) {
+        $rc = exists $types{$intype};
+        last if ($name eq 'all' and not $rc) or ($name eq 'any' and $rc);
+      }
+    }
+
+    return $rc;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->rule_obj_var ([$read]);
+#
+# DESCRIPTION
+#   This method returns a string containing the make rule object variable for
+#   the current package. If $read is set, return $($string)
+# ------------------------------------------------------------------------------
+
+sub rule_obj_var {
+  my ($self, $read) = @_;
+
+  my $return;
+  if ($self->setting ('FCM_PCK_OBJECTS', $self->pkgname)) {
+    # Package name registered in unusual list
+    $return = $self->setting ('FCM_PCK_OBJECTS', $self->pkgname);
+
+  } else {
+    # Package name not registered in unusual list
+    $return = $self->pkgname
+              ? join ('__', ('OBJECTS', $self->pkgname)) : 'OBJECTS';
+  }
+
+  $return = $read ? '$(' . $return . ')' : $return;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->rule_src ();
+#
+# DESCRIPTION
+#   This method returns a string containing the location of the source file
+#   relative to the build root. This string will be suitable for use in a
+#   "Make" rule file for FCM.
+# ------------------------------------------------------------------------------
+
+sub rule_src {
+  my $self = shift;
+
+  my $return = $self->cursrc;
+  LABEL: for my $name (qw/SRC PPSRC/) {
+    for my $i (0 .. @{ $self->setting ('PATH', $name) } - 1) {
+      my $dir = $self->setting ('PATH', $name)->[$i];
+      next unless index ($self->cursrc, $dir) == 0;
+
+      $return = File::Spec->catfile (
+        '$(FCM_' . $name . 'DIR' . ($i ? $i : '') . ')',
+        File::Spec->abs2rel ($self->cursrc, $dir),
+      );
+      last LABEL;
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->write_lib_dep_excl ();
+#
+# DESCRIPTION
+#   This method writes a set of exclude dependency configurations for the
+#   library of this package.
+# ------------------------------------------------------------------------------
+
+sub write_lib_dep_excl {
+  my $self = shift();
+  if (!find_file_in_path($self->libbase(), $self->setting(qw/PATH LIB/))) {
+    return 0;
+  }
+
+  my $ETC_DIR = $self->setting(qw/PATH ETC/)->[0];
+  my $CFG_EXT = $self->setting(qw/OUTFILE_EXT CFG/);
+  my $LABEL_OF_EXCL_DEP = $self->cfglabel('BLD_DEP_EXCL');
+  my @SETTINGS = (
+       #dependency   #source file type list       #dependency name function
+       ['H'        , [qw{INCLUDE CPP          }], sub {$_[0]->base()}         ],
+       ['INTERFACE', [qw{INCLUDE INTERFACE    }], sub {$_[0]->base()}         ],
+       ['INC'      , [qw{INCLUDE              }], sub {$_[0]->base()}         ],
+       ['USE'      , [qw{SOURCE FORTRAN MODULE}], sub {$_[0]->root()}         ],
+       ['INTERFACE', [qw{SOURCE FORTRAN       }], sub {$_[0]->interfacebase()}],
+       ['OBJ'      , [qw{SOURCE               }], sub {$_[0]->root()}         ],
+  );
+
+  my $cfg = Fcm::CfgFile->new();
+  my @stack = ($self);
+  NODE:
+  while (my $node = pop(@stack)) {
+    # Is a directory
+    if (@{$node->children()}) {
+      push(@stack, reverse(@{$node->children()}));
+      next NODE;
+    }
+    # Is a typed file
+    if (
+          $node->cursrc()
+      &&  $node->type()
+      &&  !$node->is_type_any(qw{PROGRAM BLOCKDATA})
+    ) {
+      for (@SETTINGS) {
+        my ($key, $type_list_ref, $name_func_ref) = @{$_};
+        my $name = $name_func_ref->($node);
+        if ($name && $node->is_type_all(@{$type_list_ref})) {
+          push(
+            @{$cfg->lines()},
+            Fcm::CfgLine->new(
+              label => $LABEL_OF_EXCL_DEP,
+              value => $key . $Fcm::Config::DELIMITER . $name,
+            ),
+          );
+          next NODE;
+        }
+      }
+    }
+  }
+
+  # Write to configuration file
+  $cfg->print_cfg(
+    File::Spec->catfile($ETC_DIR, $self->libbase('lib', $CFG_EXT)),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->write_rules ();
+#
+# DESCRIPTION
+#   This method returns a string containing the "Make" rules for building the
+#   source file.
+# ------------------------------------------------------------------------------
+
+sub write_rules {
+  my $self  = shift;
+  my $mk    = '';
+
+  for my $target (sort keys %{ $self->rules }) {
+    my $rule = $self->rules ($target);
+    next unless defined ($rule->{ACTION});
+
+    if ($rule->{ACTION} eq 'AR') {
+      my $var = $self->rule_obj_var;
+      $mk .= ($var eq 'OBJECTS' ? 'export ' : '') . $var . ' =';
+      $mk .= ' ' . join (' ', @{ $rule->{DEP} });
+      $mk .= "\n\n";
+    }
+
+    $mk .= $target . ':';
+    
+    if ($rule->{ACTION} eq 'AR') {
+      $mk .= ' ' . $self->rule_obj_var (1);
+
+    } else {
+      for my $dep (@{ $rule->{DEP} }) {
+        $mk .= ' ' . $dep;
+      }
+    }
+
+    $mk .= "\n";
+
+    if (exists $rule->{ACTION}) {
+      if ($rule->{ACTION} eq 'AR') {
+        $mk .= "\t" . 'fcm_internal archive $@ $^' . "\n";
+
+      } elsif ($rule->{ACTION} eq 'CP') {
+        $mk .= "\t" . 'cp $< ' . $rule->{DEST} . "\n";
+        $mk .= "\t" . 'chmod u+w ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+
+      } elsif ($rule->{ACTION} eq 'CP_DATA') {
+        $mk .= "\t" . 'cp $^ ' . $rule->{DEST} . "\n";
+        $mk .= "\t" . 'touch ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+
+      } elsif ($rule->{ACTION} eq 'COMPILE') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal compile:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->pkgnames->[-2] . ' $< $@';
+          $mk .= ' 1' if ($self->flagsbase ('PPKEYS') and not $self->ppsrc);
+          $mk .= "\n";
+        }
+
+      } elsif ($rule->{ACTION} eq 'LOAD') {
+        if ($self->lang) {
+          $mk .= "\t" . 'fcm_internal load:' . substr ($self->lang, 0, 1) .
+                 ' ' . $self->pkgnames->[-2] . ' $< $@';
+          $mk .= ' ' . join (' ', @{ $rule->{BLOCKDATA} })
+            if @{ $rule->{BLOCKDATA} };
+          $mk .= "\n";
+        }
+
+      } elsif ($rule->{ACTION} eq 'TOUCH') {
+        $mk .= "\t" . 'touch ' .
+               File::Spec->catfile ($rule->{DEST}, '$@') . "\n";
+      }
+    }
+
+    $mk .= "\n";
+  }
+
+  return $mk;
+}
+
+# Wraps "chdir". Returns old directory.
+sub _chdir {
+  my ($self, $dir) = @_;
+  my $old_cwd = cwd();
+  $self->_event('CHDIR', $dir);
+  chdir($dir) || croak(sprintf($ERR_MESS_OF{CHDIR}, $dir));
+  $old_cwd;
+}
+
+# Wraps an event.
+sub _event {
+  my ($self, $key, @args) = @_;
+  my ($format, $level) = @{$EVENT_SETTING_OF{$key}};
+  $level ||= 1;
+  if ($self->verbose() >= $level) {
+    printf($format . ".\n", @args);
+  }
+}
+
+# Wraps "open".
+sub _open {
+  my ($path, $mode) = @_;
+  $mode ||= '<';
+  open(my $handle, $mode, $path) || croak(sprintf($ERR_MESS_OF{OPEN}, $path, $!));
+  $handle;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/BuildTask.pm
===================================================================
--- vendors/FCM/lib/Fcm/BuildTask.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/BuildTask.pm	(revision 9621)
@@ -0,0 +1,340 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::BuildTask
+#
+# DESCRIPTION
+#   This class hosts information of a build task in the FCM build system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::BuildTask;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use strict;
+use warnings;
+
+# Standard modules
+use Carp;
+use File::Compare;
+use File::Copy;
+use File::Basename;
+use File::Path;
+use File::Spec::Functions;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::Timer;
+use Fcm::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'actiontype',  # type of action
+  'dependency',  # list of dependencies for this target
+  'srcfile',     # reference to input Fcm::BuildSrc instance
+  'output',      # output file
+  'outputmtime', # output file modification time
+  'target',      # target name for this task
+  'targetpath',  # search path for the target
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::BuildTask->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::BuildTask class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  bless $self, $class;
+
+  for my $name (@scalar_properties) {
+    $self->{$name} = exists $args{uc ($name)} ? $args{uc ($name)} : undef;
+  }
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'output') {
+        $self->{outputmtime} = $_[0] ? (stat $_[0]) [9] : undef;
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'dependency' or $name eq 'targetpath') {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->action (TASKLIST => \%tasklist);
+#
+# DESCRIPTION
+#   This method performs the task action and sets the output accordingly. The
+#   argument TASKLIST must be a reference to a hash containing the other tasks
+#   of the build, which this task may depend on. The keys of the hash must the
+#   name of the target names of the tasks, and the values of the hash must be
+#   the references to the corresponding Fcm::BuildTask instances. The method
+#   returns true if the task has been performed to create a new version of the
+#   target.
+# ------------------------------------------------------------------------------
+
+sub action {
+  my $self     = shift;
+  my %args     = @_;
+  my $tasklist = exists $args{TASKLIST} ? $args{TASKLIST} : {};
+
+  return unless $self->actiontype;
+
+  my $uptodate     = 1;
+  my $dep_uptodate = 1;
+
+  # Check if dependencies are up to date
+  # ----------------------------------------------------------------------------
+  for my $depend (@{ $self->dependency }) {
+    if (exists $tasklist->{$depend}) {
+      if (not $tasklist->{$depend}->output) {
+        # Dependency task output is not set, performs its task action
+        if ($tasklist->{$depend}->action (TASKLIST => $tasklist)) {
+          $uptodate     = 0;
+          $dep_uptodate = 0;
+        }
+      }
+
+    } elsif ($self->verbose > 1) {
+      w_report 'Warning: Task for "', $depend,
+               '" does not exist, may be required by ', $self->target;
+    }
+  }
+
+  # Check if the target exists in the search path
+  # ----------------------------------------------------------------------------
+  if (@{ $self->targetpath }) {
+    my $output = find_file_in_path ($self->target, $self->targetpath);
+    $self->output ($output) if $output;
+  }
+
+  # Target is out of date if it does not exist
+  if ($uptodate) {
+    $uptodate = 0 if not $self->output;
+  }
+
+  # Check if current target is older than its dependencies
+  # ----------------------------------------------------------------------------
+  if ($uptodate) {
+    for my $depend (@{ $self->dependency }) {
+      next unless exists $tasklist->{$depend};
+
+      if ($tasklist->{$depend}->outputmtime > $self->outputmtime) {
+        $uptodate     = 0;
+        $dep_uptodate = 0;
+      }
+    }
+
+    if ($uptodate and ref $self->srcfile) {
+      $uptodate = 0 if $self->srcfile->mtime > $self->outputmtime;
+    }
+  }
+
+  if ($uptodate) {
+    # Current target and its dependencies are up to date
+    # --------------------------------------------------------------------------
+    if ($self->actiontype eq 'PP') {
+      # "done" file up to date, set name of pre-processed source file
+      # ------------------------------------------------------------------------
+      my $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+      my @pknames  = split '__', (@{ $self->srcfile->pkgnames })[-2];
+      my @path     = map {
+        catfile ($_, @pknames);
+      } @{ $self->setting (qw/PATH PPSRC/) };
+      my $oldfile = find_file_in_path ($base, \@path);
+      $self->srcfile->ppsrc ($oldfile);
+    }
+
+  } else {
+    # Perform action is not up to date
+    # --------------------------------------------------------------------------
+    # (For GENINTERFACE and PP, perform action if "done" file not up to date)
+    my $new_output = @{ $self->targetpath }
+                     ? catfile ($self->targetpath->[0], $self->target)
+                     : $self->target;
+
+    # Create destination container directory if necessary
+    my $destdir = dirname $new_output;
+
+    if (not -d $destdir) {
+      print 'Make directory: ', $destdir, "\n" if $self->verbose > 2;
+      mkpath $destdir;
+    }
+
+    # List of actions
+    if ($self->actiontype eq 'UPDATE') {
+      # Action is UPDATE: Update file
+      # ------------------------------------------------------------------------
+      print 'Update: ', $new_output, "\n" if $self->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } elsif ($self->actiontype eq 'COPY') {
+      # Action is COPY: copy file to destination if necessary
+      # ------------------------------------------------------------------------
+      my $copy_required = ($dep_uptodate and $self->output and -r $self->output)
+                          ? compare ($self->output, $self->srcfile->src)
+                          : 1;
+
+      if ($copy_required) {
+        # Set up copy command
+        my $srcfile = $self->srcfile->src;
+        my $destfile = catfile ($destdir, basename($srcfile));
+        print 'Copy: ', $srcfile, "\n", '  to: ', $destfile, "\n"
+          if $self->verbose > 2;
+        &copy ($srcfile, $destfile)
+          or die $srcfile, ': copy to ', $destfile, ' failed (', $!, '), abort';
+        chmod (((stat ($srcfile))[2] & 07777), $destfile);
+
+        $self->output ($new_output);
+
+      } else {
+        $uptodate = 1;
+      }
+
+    } elsif ($self->actiontype eq 'PP' or $self->actiontype eq 'GENINTERFACE') {
+      # Action is PP or GENINTERFACE: process file
+      # ------------------------------------------------------------------------
+      my ($newlines, $base, @path);
+
+      if ($self->actiontype eq 'PP') {
+        # Invoke the pre-processor on the source file
+        # ----------------------------------------------------------------------
+        # Get lines in the pre-processed source
+        $newlines = $self->srcfile->get_pre_process;
+        $base     = $self->srcfile->root . lc ($self->srcfile->ext);
+
+        # Get search path for the existing pre-processed file
+        my @pknames  = split '__', (@{ $self->srcfile->pkgnames })[-2];
+        @path        = map {
+          catfile ($_, @pknames);
+        } @{ $self->setting (qw/PATH PPSRC/) };
+
+      } else { # if ($self->actiontype eq 'GENINTERFACE')
+        # Invoke the interface generator
+        # ----------------------------------------------------------------------
+        # Get new interface lines
+        $newlines = $self->srcfile->get_fortran_interface;
+
+        # Get search path for the existing interface file
+        $base     = $self->srcfile->interfacebase;
+        @path     = @{ $self->setting (qw/PATH INC/) },
+      }
+
+
+      # If pre-processed or interface file exists,
+      # compare its content with new lines to see if it has been updated
+      my $update_required = 1;
+      my $oldfile = find_file_in_path ($base, \@path);
+
+      if ($oldfile and -r $oldfile) {
+        # Read old file
+        open FILE, '<', $oldfile;
+        my @oldlines = readline 'FILE';
+        close FILE;
+
+        # Compare old contents and new contents
+        if (@oldlines eq @$newlines) {
+          $update_required = grep {
+            $oldlines[$_] ne $newlines->[$_];
+          } (0 .. $#oldlines);
+        }
+      }
+
+      if ($update_required) {
+        # Update the pre-processed source or interface file
+        # ----------------------------------------------------------------------
+        # Determine container directory of the  pre-processed or interface file
+        my $newfile = @path ? catfile ($path[0], $base) : $base;
+
+        # Create the container directory if necessary
+        if (not -d $path[0]) {
+          print 'Make directory: ', $path[0], "\n"
+            if $self->verbose > 1;
+          mkpath $path[0];
+        }
+
+        # Update the pre-processor or interface file
+        open FILE, '>', $newfile
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print FILE @$newlines;
+        close FILE
+          or croak 'Cannot write to "', $newfile, '" (', $!, '), abort';
+        print 'Generated: ', $newfile, "\n" if $self->verbose > 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($newfile) if $self->actiontype eq 'PP';
+
+      } else {
+        # Content in pre-processed source or interface file is up to date
+        # ----------------------------------------------------------------------
+        $uptodate = 1;
+
+        # Set the name of the pre-processed file
+        $self->srcfile->ppsrc ($oldfile) if $self->actiontype eq 'PP';
+      }
+
+      # Update the "done" file
+      print 'Update: ', $new_output, "\n" if $self->verbose > 2;
+      touch_file $new_output
+        or croak 'Unable to update "', $new_output, '", abort';
+      $self->output ($new_output);
+
+    } else {
+      carp 'Action type "', $self->actiontype, "' not supported";
+    }
+  }
+
+  return not $uptodate;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/CLI.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI.pm	(revision 9621)
@@ -0,0 +1,172 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI;
+
+use Carp qw{croak};
+use Fcm::CLI::Config;
+use Fcm::CLI::Exception;
+use Fcm::Util::ClassLoader;
+use File::Basename qw{basename};
+use Getopt::Long qw{GetOptions};
+use Scalar::Util qw{blessed};
+
+################################################################################
+# Invokes the FCM command line interface
+sub invoke {
+    local(@ARGV) = @ARGV;
+    my $config          = Fcm::CLI::Config->instance();
+    my $subcommand_name = @ARGV ? shift(@ARGV) : q{};
+    my $subcommand      = $config->get_subcommand_of($subcommand_name);
+    eval {
+        if (!$subcommand) {
+            croak(Fcm::CLI::Exception->new({message => 'unknown command'}));
+        }
+        my ($opts_ref, $args_ref, $is_help) = _parse_argv_using($subcommand);
+        my ($invoker_class, $invoker);
+        if ($is_help) {
+            $invoker_class
+                = _load_invoker_class_of($config->get_subcommand_of(q{}));
+            $invoker = $invoker_class->new({
+                command   => $subcommand_name,
+                arguments => [$subcommand_name],
+            });
+        }
+        else {
+            $invoker_class = _load_invoker_class_of($subcommand);
+            $invoker = $invoker_class->new({
+                command   => $subcommand_name,
+                options   => $opts_ref,
+                arguments => $args_ref,
+                (
+                    $subcommand->get_invoker_config()
+                    ? %{$subcommand->get_invoker_config()}
+                    : ()
+                ),
+            });
+        }
+        $invoker->invoke();
+    };
+    if ($@) {
+        if (Fcm::CLI::Exception->caught($@)) {
+            die(sprintf(
+                qq{%s%s: %s\nType "%s help%s" for usage\n},
+                basename($0),
+                ($subcommand_name ? qq{ $subcommand_name} : q{}),
+                $@->get_message(),
+                basename($0),
+                defined($subcommand) ? qq{ $subcommand_name} : q{},
+            ));
+        }
+        else {
+            die($@);
+        }
+    }
+}
+
+################################################################################
+# Parses options in @ARGV using the options settings of a subcommand
+sub _parse_argv_using {
+    my ($subcommand) = @_;
+    my %options = ();
+    my $is_help = undef;
+    if (($subcommand->get_options())) {
+        my $problem = q{};
+        local($SIG{__WARN__}) = sub {
+            ($problem) = @_;
+        };
+        my $success = GetOptions(
+            \%options,
+            (map {$_->get_arg_for_getopt_long()} ($subcommand->get_options())),
+        );
+        if (!$success) {
+            croak(Fcm::CLI::Exception->new({message => sprintf(
+                "option parse failed: %s", $problem,
+            )}));
+        }
+
+        OPTION:
+        for my $option ($subcommand->get_options()) {
+            if (!exists($options{$option->get_name()})) {
+                next OPTION;
+            }
+            if ($option->is_help()) {
+                $is_help = 1;
+            }
+            if (
+                $option->has_arg() == $option->ARRAY_ARG
+                && $option->get_delimiter()
+            ) {
+                $options{$option->get_name()} = [split(
+                    $option->get_delimiter(),
+                    join(
+                        $option->get_delimiter(),
+                        @{$options{$option->get_name()}},
+                    ),
+                )];
+            }
+        }
+    }
+    return (\%options, [@ARGV], $is_help);
+}
+
+################################################################################
+# Loads and returns the invoker class of a subcommand
+sub _load_invoker_class_of {
+    my ($subcommand) = @_;
+    my $invoker_class
+        = $subcommand->get_invoker_class() ? $subcommand->get_invoker_class()
+        :                                    'Fcm::CLI::Invoker'
+        ;
+    return Fcm::Util::ClassLoader::load($invoker_class);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI
+    Fcm::CLI::invoke();
+
+=head1 DESCRIPTION
+
+Invokes the FCM command line interface.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item invoke()
+
+Invokes the FCM command line interface.
+
+=back
+
+=head1 TO DO
+
+Move option/argument parsing to L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>?
+
+Use an OO interface?
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Config|Fcm::CLI::Config>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Config.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Config.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Config.pm	(revision 9621)
@@ -0,0 +1,133 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Config;
+
+use Fcm::CLI::Config::Default;
+use List::Util qw{first};
+use Scalar::Util qw{blessed};
+
+my $INSTANCE;
+
+################################################################################
+# Class method: returns an instance of this class
+sub instance {
+    my ($class, $args_ref) = @_;
+    if ($args_ref || !$INSTANCE) {
+        $INSTANCE = bless({
+            core_subcommands => [@Fcm::CLI::Config::Default::CORE_SUBCOMMANDS],
+            vc_subcommands   => [@Fcm::CLI::Config::Default::VC_SUBCOMMANDS],
+            (defined($args_ref) ? %{$args_ref} : ()), 
+        }, $class);
+    }
+    return $INSTANCE;
+}
+
+################################################################################
+# Returns a subcommand matching $key
+sub get_subcommand_of {
+    my ($self, $key) = @_;
+    if (blessed($key) && $key->isa('Fcm::CLI::Subcommand')) {
+        return first {"$_" eq "$key"} ($self->get_subcommands());
+    }
+    else {
+        return first {$_->has_a_name($key)} ($self->get_subcommands());
+    }
+}
+
+################################################################################
+# Returns the subcommands
+sub get_subcommands {
+    my ($self) = @_;
+    my @return = ($self->get_core_subcommands(), $self->get_vc_subcommands());
+    return (wantarray() ? @return : \@return);
+}
+
+################################################################################
+# Returns the core subcommands
+sub get_core_subcommands {
+    my ($self) = @_;
+    return (
+        wantarray() ? @{$self->{core_subcommands}} : $self->{core_subcommands}
+    );
+}
+
+################################################################################
+# Returns the subcommands that are relevant only with a VC system
+sub get_vc_subcommands {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{vc_subcommands}} : $self->{vc_subcommands});
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Config
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Config;
+    $cli_config = Fcm::CLI::Config->instance();
+    $subcommand = $cli_config->get_subcommand_of($key);
+    @subcommands = $cli_config->get_subcommands();
+    @core_subcommands = $cli_config->get_core_subcommands();
+    @vc_subcommands = $cli_config->get_vc_subcommands();
+
+=head1 DESCRIPTION
+
+This class provides the configuration of the FCM command line interface.
+
+=head1 METHODS
+
+=over 4
+
+=item instance($arg_ref)
+
+Returns an instance of this class.
+
+Creates the instance on first call, or replaces it with a new one if $args_ref
+is defined in subsequent call. $args_ref should be a reference to a hash. The
+hash can contain I<core_subcommands> and I<vc_subcommands>. Each of these
+settings should point to an array reference containing L<Fcm::CLI::Subcommand>
+objects. If the setting is unspecified, it uses the default from
+L<Fcm::CLI::Config::Default|Fcm::CLI::Config::Default>.
+
+=item get_subcommand_of($key)
+
+Returns a L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand> object matching the
+search $key. Returns undef if there is no match.
+
+=item get_subcommands()
+
+Short-hand for:
+    ($self->get_core_subcommands(), $self->get_vc_subcommands())
+
+=item get_core_subcommands()
+
+Returns the core subcommands.
+
+=item get_vc_subcommands()
+
+Returns the subcommands that are relevant only in the presence of a VC system.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Config::Default|Fcm::CLI::Config::Default>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Config/Default.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Config/Default.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Config/Default.pm	(revision 9621)
@@ -0,0 +1,412 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Config::Default;
+
+use Fcm::CLI::Option;
+use Fcm::CLI::Subcommand;
+
+my %DESCRIPTION_OF = (
+    # --------------------------------------------------------------------------
+    BROWSER => <<'END_DESCRIPTION',
+If TARGET is specified, it must be a FCM URL keyword, a Subversion URL or the
+path to a local working copy. If not specified, the current working directory
+is assumed to be a working copy. If the --browser option is specified, the
+specified web browser command is used to launch the repository browser.
+Otherwise, it attempts to use the default browser from the configuration
+setting.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    BUILD => <<'END_DESCRIPTION',
+The path to a CFGFILE may be provided. Otherwise, the build system searches the
+default locations for a bld cfg file.
+
+If no option is specified, the options "-s 5 -t all -j 1 -v 1" are assumed.
+
+If the option for full build is specified, the sub-directories created by
+previous builds will be removed, so that the current build can start cleanly.
+
+The -s option can be used to limit the actions performed by the build system up
+to a named stage. The stages are:
+    "1", "s" or "setup"                - stage 1, setup
+    "2", "pp" or "pre_process"         - stage 2, pre-process
+    "3", "gd" or "generate_dependency" - stage 3, generate dependency
+    "4", "gi" or "generate_interface"  - stage 4, generate Fortran 9X interface
+    "5", "m", "make"                   - stage 5, make
+
+If a colon separated list of targets is specified using the -t option, the
+default targets specified in the configuration file will not be used.
+
+If archive mode is switched on, build sub-directories that are only used in the
+build process will be archived to TAR files. The default is off.
+
+If specified, the verbose level must be an integer greater than 0. Verbose
+level 0 is the quiet mode. Increasing the verbose level will increase the
+amount of diagnostic output.
+
+When a build is invoked, it sets up a lock file in the build root directory.
+The lock is normally removed at the end of the build. While the lock file is in
+place, the build commands invoked in the same root directory will fail.  If
+you need to bypass this check for whatever reason, you can invoke the build
+system with the --ignore-lock option.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    CFG_PRINTER => <<'END_DESCRIPTION',
+If no option is specified, the output will be sent to standard output.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    EXTRACT => <<'END_DESCRIPTION',
+The path to a CFG file may be provided. Otherwise, the extract system searches
+the default locations for an ext cfg file.
+
+If no option is specified, the system will attempt an incremental extract where
+appropriate.
+
+If specified, the verbose level must be an integer greater than 0. Verbose
+level 0 is the quiet mode. Increasing the verbose level will increase the
+amount of diagnostic output.
+
+When an extract is invoked, it sets up a lock file in the extract destination
+root directory. The lock is normally removed at the end of the extract. While
+the lock file is in place, other extract commands invoked in the same
+destination root directory will fail. If you need to bypass this check for
+whatever reason, you can invoke the extract system with the --ignore-lock
+option.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    EXTRACT_CONFIG_COMPARATOR => <<'END_DESCRIPTION',
+Compares the extract configurations of two similar extract configuration files
+CFGFILE1 and CFGFILE2.
+
+In normal mode with verbosity level 2 or above, displays the change log of each
+revision.
+
+In wiki mode, print revision tables in wiki format. The argument to the --wiki
+option must be the Subversion URL or FCM URL keyword of a FCM project
+associated with the intended Trac system. The --verbose option has no effect
+in wiki mode.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    GUI => <<'END_DESCRIPTION',
+The optional argument PATH modifies the initial working directory of the GUI.
+END_DESCRIPTION
+    # --------------------------------------------------------------------------
+    KEYWORD => <<'END_DESCRIPTION',
+If no argument is specified, prints registered location keywords. Otherwise,
+prints the implied location keywords and revision keywords for the specified
+target.
+END_DESCRIPTION
+);
+
+my %OPTION_OF = (
+    ARCHIVE => Fcm::CLI::Option->new({
+        name        => 'archive',
+        letter      => 'a',
+        description => 'archives sub-directories on success',
+    }),
+
+    BROWSER => Fcm::CLI::Option->new({
+        name        => 'browser',
+        letter      => 'b',
+        description => 'specifies the web browser command',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    CLEAN => Fcm::CLI::Option->new({
+        name        => 'clean',
+        description => 'cleans the destination',
+    }),
+
+    FULL => Fcm::CLI::Option->new({
+        name        => 'full',
+        letter      => 'f',
+        description => 'runs in full mode',
+    }),
+
+    HELP => Fcm::CLI::Option->new({
+        name        => 'help',
+        letter      => 'h',
+        description => 'prints help',
+        is_help     => 1,
+    }),
+
+    IGNORE_LOCK => Fcm::CLI::Option->new({
+        name        => 'ignore-lock',
+        description => 'ignores lock file',
+    }),
+
+    JOBS => Fcm::CLI::Option->new({
+        name        => 'jobs',
+        letter      => 'j',
+        description => 'number of parallel jobs',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    OUTPUT => Fcm::CLI::Option->new({
+        name        => 'output',
+        letter      => 'o',
+        description => 'sends output to the specified file',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    STAGE => Fcm::CLI::Option->new({
+        name        => 'stage',
+        letter      => 's',
+        description => 'runs command up to a named stage',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    TARGETS => Fcm::CLI::Option->new({
+        name        => 'targets',
+        letter      => 't',
+        delimiter   => ':',
+        description => 'list of build targets, delimited by (:)',
+        has_arg     => Fcm::CLI::Option->ARRAY_ARG,
+    }),
+
+    VERBOSITY => Fcm::CLI::Option->new({
+        name        => 'verbose',
+        letter      => 'v',
+        description => 'verbose level',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+
+    WIKI => Fcm::CLI::Option->new({
+        name        => 'wiki',
+        letter      => 'w',
+        description => 'print revision tables in wiki format',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+    }),
+);
+
+my %SUBCOMMAND_OF = (
+    BRANCH => Fcm::CLI::Subcommand->new({
+        names         => ['branch', 'br'],
+        synopsis      => 'branch utilities',
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+
+    BROWSER => Fcm::CLI::Subcommand->new({
+        names         => ['trac', 'www'],
+        synopsis      => 'invokes the browser for a version controlled target',
+        usage         => '[OPTIONS...] [TARGET]',
+        description   => $DESCRIPTION_OF{BROWSER},
+        invoker_class => 'Fcm::CLI::Invoker::Browser',
+        options       => [
+            $OPTION_OF{BROWSER},
+            $OPTION_OF{HELP},
+        ],
+    }),
+
+    BUILD => Fcm::CLI::Subcommand->new({
+        names          => ['build', 'bld'],
+        synopsis       => 'invokes the build system',
+        usage          => '[OPTIONS...] [CFGFILE]',
+        description    => $DESCRIPTION_OF{BUILD},
+        invoker_class  => 'Fcm::CLI::Invoker::ConfigSystem',
+        invoker_config => {
+            impl_class         => 'Fcm::Build',
+            cli2invoke_key_map => {
+                'archive'     => 'ARCHIVE',
+                'clean'       => 'CLEAN',
+                'full'        => 'FULL',
+                'ignore-lock' => 'IGNORE_LOCK',
+                'jobs'        => 'JOBS',
+                'stage'       => 'STAGE',
+                'targets'     => 'TARGETS',
+            },
+        },
+        options        => [
+            $OPTION_OF{ARCHIVE},
+            $OPTION_OF{CLEAN},
+            $OPTION_OF{FULL},
+            $OPTION_OF{HELP},
+            $OPTION_OF{IGNORE_LOCK},
+            $OPTION_OF{JOBS},
+            $OPTION_OF{STAGE},
+            $OPTION_OF{TARGETS},
+            $OPTION_OF{VERBOSITY},
+        ],
+    }),
+
+    CFG_PRINTER => Fcm::CLI::Subcommand->new({
+        names         => ['cfg'],
+        synopsis      => 'invokes the CFG file pretty printer',
+        usage         => '[OPTIONS...] [CFGFILE]',
+        description   => $DESCRIPTION_OF{CFG_PRINTER},
+        invoker_class => 'Fcm::CLI::Invoker::CfgPrinter',
+        options       => [
+            $OPTION_OF{HELP},
+            $OPTION_OF{OUTPUT},
+        ],
+    }),
+
+    CM => Fcm::CLI::Subcommand->new({
+        names => [qw{
+            add
+            blame     praise annotate ann
+            cat
+            checkout  co
+            cleanup
+            commit    ci
+            copy      cp
+            delete    del    remove   rm
+            diff      di
+            export
+            import
+            info
+            list      ls
+            lock
+            log
+            merge
+            mkdir
+            move      mv     rename   ren
+            propdel   pdel   pd
+            propedit  pedit  pe
+            propget   pget   pg
+            proplist  plist  pl
+            propset   pset   ps
+            resolved
+            revert
+            status    stat   st
+            switch    sw
+            unlock
+            update    up
+        }],
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+
+    CONFLICTS => Fcm::CLI::Subcommand->new({
+        names         => ['conflicts', 'cf'],
+        synopsis      => 'resolves conflicts in your working copy',
+        usage         => '[PATH]',
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+
+    EXTRACT => Fcm::CLI::Subcommand->new({
+        names          => ['extract', 'ext'],
+        synopsis       => 'invokes the extract system',
+        usage          => '[OPTIONS...] [CFGFILE]',
+        description    => $DESCRIPTION_OF{EXTRACT},
+        invoker_class  => 'Fcm::CLI::Invoker::ConfigSystem',
+        invoker_config => {
+            impl_class         => 'Fcm::Extract',
+            cli2invoke_key_map => {
+                'clean'       => 'CLEAN',
+                'full'        => 'FULL',
+                'ignore-lock' => 'IGNORE_LOCK',
+            },
+        },
+        options        => [
+            $OPTION_OF{CLEAN},
+            $OPTION_OF{FULL},
+            $OPTION_OF{HELP},
+            $OPTION_OF{IGNORE_LOCK},
+            $OPTION_OF{VERBOSITY},
+        ],
+    }),
+
+    EXTRACT_CONFIG_COMPARATOR => Fcm::CLI::Subcommand->new({
+        names         => ['cmp-ext-cfg'],
+        synopsis      => 'invokes the extract configuration files comparator',
+        usage         => '[OPTIONS...] CFGFILE1 CFGFILE2',
+        description   => $DESCRIPTION_OF{EXTRACT_CONFIG_COMPARATOR},
+        invoker_class => 'Fcm::CLI::Invoker::ExtractConfigComparator',
+        options       => [
+            $OPTION_OF{HELP},
+            $OPTION_OF{VERBOSITY},
+            $OPTION_OF{WIKI},
+        ],
+    }),
+
+    GUI => Fcm::CLI::Subcommand->new({
+        names         => ['gui'],
+        synopsis      => 'invokes the GUI wrapper for code management commands',
+        usage         => '[PATH]',
+        description   => $DESCRIPTION_OF{GUI},
+        invoker_class => 'Fcm::CLI::Invoker::GUI',
+    }),
+
+    HELP => Fcm::CLI::Subcommand->new({
+        names         => ['help', q{?}, q{}],
+        synopsis      => 'displays the usage of this program or its subcommands',
+        usage         => '[SUBCOMMAND]',
+        description   => q{},
+        invoker_class => 'Fcm::CLI::Invoker::Help',
+        options       => [$OPTION_OF{HELP}],
+    }),
+
+    KEYWORD => Fcm::CLI::Subcommand->new({
+        names         => ['keyword-print', 'kp'],
+        synopsis      => 'prints registered location and/or revision keywords',
+        usage         => '[TARGET]',
+        description   => $DESCRIPTION_OF{KEYWORD},
+        invoker_class => 'Fcm::CLI::Invoker::KeywordPrinter',
+        options       => [$OPTION_OF{HELP}],
+    }),
+
+    MKPATCH => Fcm::CLI::Subcommand->new({
+        names         => ['mkpatch'],
+        synopsis      => 'creates patches from specified revisions of a URL',
+        usage         => '[OPTIONS] URL [OUTDIR]',
+        invoker_class => 'Fcm::CLI::Invoker::CM',
+        is_vc         => 1,
+    }),
+);
+
+our @CORE_SUBCOMMANDS = (
+    $SUBCOMMAND_OF{HELP},
+    $SUBCOMMAND_OF{BUILD},
+    $SUBCOMMAND_OF{CFG_PRINTER},
+);
+
+our @VC_SUBCOMMANDS = (
+    $SUBCOMMAND_OF{BRANCH},
+    $SUBCOMMAND_OF{BROWSER},
+    $SUBCOMMAND_OF{CONFLICTS},
+    $SUBCOMMAND_OF{EXTRACT},
+    $SUBCOMMAND_OF{EXTRACT_CONFIG_COMPARATOR},
+    $SUBCOMMAND_OF{GUI},
+    $SUBCOMMAND_OF{KEYWORD},
+    $SUBCOMMAND_OF{MKPATCH},
+    $SUBCOMMAND_OF{CM},
+);
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Config::Default
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Config::Default;
+    @core_subcommands = @Fcm::CLI::Config::Default::CORE_SUBCOMMANDS;
+    @vc_subcommands = @Fcm::CLI::Config::Default::VC_SUBCOMMANDS;
+
+=head1 DESCRIPTION
+
+This module stores the default configuration of the FCM command line interface.
+It should only be used by L<Fcm::CLI::Config|Fcm::CLI::Config>.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Config|Fcm::CLI::Config>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Exception.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Exception.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Exception.pm	(revision 9621)
@@ -0,0 +1,42 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Exception;
+use base qw{Fcm::Exception};
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Exception
+
+=head1 SYNOPSIS
+
+    use Carp qw{croak};
+    use Fcm::CLI::Exception;
+    croak(Fcm::CLI::Exception->new({message => 'something is wrong'}));
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::Exception|Fcm::Exception>. This exception is thrown
+on errors associated with the command line interface.
+
+=head1 METHODS
+
+See L<Fcm::Exception|Fcm::Exception> for a list of methods.
+
+=head1 SEE ALSO
+
+L<Fcm::Exception|Fcm::Exception>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker.pm	(revision 9621)
@@ -0,0 +1,136 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker;
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns the name of the (sub)command as given by the user
+sub get_command {
+    my ($self) = @_;
+    return $self->{command};
+}
+
+################################################################################
+# Returns a reference to a hash containing the options
+sub get_options {
+    my ($self) = @_;
+    return (wantarray() ? %{$self->{options}} : $self->{options});
+}
+
+################################################################################
+# Returns a reference to an array containing the arguments
+sub get_arguments {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{arguments}} : $self->{arguments});
+}
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my $message = "command not implemented\n";
+    $message .= sprintf("opts:");
+    for my $key (sort keys(%{$self->get_options()})) {
+        my $value = $self->get_options()->{$key};
+        $message .= sprintf(
+            " [%s=%s]",
+            $key,
+            ($value && ref($value) eq 'ARRAY' ? join(q{, }, @{$value}) : $value)
+        );
+    }
+    $message .= sprintf("\n");
+    $message .= sprintf("args: [%s]\n", join(q{] [}, $self->get_arguments()));
+    croak(Fcm::CLI::Exception->new({message => $message}));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker;
+    $invoker = Fcm::CLI::Invoker->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This is the base class for an invoker of a FCM sub-system from the CLI.
+Sub-classes should override the invoke() method.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor. It accepts a hash reference as an argument. The element I<command>
+should be set to the actual (sub)command as specified by the user. The element
+I<options> should be a reference to a hash containing the specified command line
+options. The element I<arguments> should be a reference to an array containing
+the remaining command line arguments.
+
+=item get_command()
+
+Returns the actual (sub)command as specified by the user.
+
+=item get_options()
+
+Returns a hash containing the specified command line options. In scalar context,
+returns a reference to the hash.
+
+=item get_arguments()
+
+Returns an array containing the (remaining) command line arguments. In scalar
+context, returns a reference to the array.
+
+=item invoke()
+
+Sub-classes should override this method. Calling the method in this base
+class causes the system to croak() with a
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The C<invoke()> croak() with this exception.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/Browser.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/Browser.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/Browser.pm	(revision 9621)
@@ -0,0 +1,119 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::Browser;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Util qw{expand_tilde get_url_of_wc is_wc run_command};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my $config = Fcm::Config->instance();
+    my $browser
+        = $self->get_options()->{browser} ? $self->get_options()->{browser}
+        :                                   $config->setting(qw/WEB_BROWSER/)
+        ;
+    my ($target) = $self->get_arguments();
+    if (!$target) {
+        if (is_wc()) {
+            $target = q{.};
+        }
+        else {
+            croak(Fcm::CLI::Exception->new({
+                message => 'no TARGET specified and . not a working copy',
+            }));
+        }
+    }
+    $target = expand_tilde($target);
+    if (-e $target) {
+        $target = get_url_of_wc($target);
+    }
+
+    my $browser_url = Fcm::Keyword::get_browser_url($target);
+    my @command = (split(qr{\s+}xms, $browser), $browser_url);
+    run_command(\@command, METHOD => 'exec', PRINT => 1);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::Browser
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::Browser;
+    $invoker = Fcm::CLI::Invoker::Browser->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke a web browser of a VC
+location.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes a web browser for a VC target, if it can be mapped to a browser URL. If
+a target is not specified in arguments, it uses the current working directory
+as the target.
+
+If the browser option is set, it is used as the browser command. Otherwise, the
+default browser is used.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method can croak() with this exception if no target is specified
+and a target cannot be deduced from the current working directory.
+
+=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+The invoke() method can croak() with this exception if the target cannot be
+mapped to a browser URL.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::Keyword|Fcm::Keyword>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/CM.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/CM.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/CM.pm	(revision 9621)
@@ -0,0 +1,69 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::CM;
+use base qw{Fcm::CLI::Invoker};
+
+use Fcm::Cm qw{cli};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    return cli($self->get_command(), @ARGV);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::CM
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::CM;
+    $invoker = Fcm::CLI::Invoker::CM->new();
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke a command in the CM
+sub-system.
+
+It is worth noting that this is not yet a full implementation.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes a command in the CM sub-system.
+
+=back
+
+=head1 TO DO
+
+Bring the CM system into this framework.
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::Cm|Fcm::Cm>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/CfgPrinter.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/CfgPrinter.pm	(revision 9621)
@@ -0,0 +1,105 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::CfgPrinter;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::Exception;
+use Fcm::CfgFile;
+use Fcm::Config;
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my ($cfg_file) = $self->get_arguments();
+    if (!$cfg_file) {
+        croak(Fcm::CLI::Exception->new({message => 'no CFGFILE specified'}));
+    }
+    my $cfg = Fcm::CfgFile->new(SRC => $cfg_file);
+    Fcm::Config->instance()->verbose(0); # suppress message printing to STDOUT
+    my $read = $cfg->read_cfg();
+    if (!$read) {
+        croak(Fcm::Exception->new({message => sprintf(
+            "% :cannot read", $cfg_file,
+        )}));
+    }
+    $cfg->print_cfg($self->get_options()->{output});
+ }
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::CfgPrinter
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::CfgPrinter;
+    $invoker = Fcm::CLI::Invoker::CfgPrinter->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the pretty printer for FCM
+configuration files.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the pretty printer for a FCM configuration file.
+
+If the I<output> option is set, output goes to the location specified by this
+value.  Otherwise, it prints to STDOUT.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Exception|Fcm::Exception>
+
+The invoke() method can croak() with this exception if the configuration file
+cannot be read.
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method can croak() with this exception if no configuration file is
+specified.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CfgFile|Fcm::CfgFile>,
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/ConfigSystem.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/ConfigSystem.pm	(revision 9621)
@@ -0,0 +1,117 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::ConfigSystem;
+use base qw{Fcm::CLI::Invoker};
+
+use Cwd qw{cwd};
+use Fcm::CLI::Exception;
+use Fcm::Config;
+use Fcm::Util::ClassLoader;
+
+################################################################################
+# Returns a hash map to convert CLI options to system invoke options.
+sub get_cli2invoke_key_map {
+    my ($self) = @_;
+    return (
+          wantarray() ? %{$self->{cli2invoke_key_map}}
+        :               $self->{cli2invoke_key_map}
+    );
+}
+
+################################################################################
+# Returns the Fcm::ConfigSystem class for invoking the sub-system.
+sub get_impl_class {
+    my ($self) = @_;
+    return $self->{impl_class};
+}
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my $options_ref = $self->get_options();
+    if (exists($options_ref->{verbose})) {
+        Fcm::Config->instance()->verbose($options_ref->{verbose});
+    }
+
+    Fcm::Util::ClassLoader::load($self->get_impl_class());
+    my $system = $self->get_impl_class()->new();
+    my ($cfg_file) = $self->get_arguments();
+    $system->cfg()->src($cfg_file ? $cfg_file : cwd());
+
+    my %map = $self->get_cli2invoke_key_map();
+    my %invoke_args = map {($map{$_}, $options_ref->{$_})} keys(%map);
+    $system->invoke(%invoke_args);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoke::ConfigSystem
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::ConfigSystem;
+    $invoker = Fcm::CLI::Invoker::ConfigSystem->new({
+        command            => $command,
+        options            => \%options,
+        arguments          => $arguments,
+        impl_class         => $class_name,
+        cli2invoke_key_map => {
+            option => 'OPTION',
+            # ... more keys
+        },
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> and inherits all its
+methods. An object of this class is used to invoke a
+L<Fcm::ConfigSystem|Fcm::ConfigSystem>, e.g. extract and build.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item get_cli2invoke_key_map()
+
+Returns a hash containing a mapping table from the names of the relevant command
+line options to the names to be given to the invoke() method of the implementing
+L<Fcm::ConfigSystem|Fcm::ConfigSystem> object.
+
+=item get_impl_class()
+
+Returns the actual class that implements L<Fcm::ConfigSystem|Fcm::ConfigSystem>.
+An object of this implementation will be created and used by invoke().
+
+=item invoke()
+
+Invokes the L<Fcm::ConfigSystem|Fcm::ConfigSystem> sub-system. If a
+configuration file is not specified in the argument, it uses the current working
+directory.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::ConfigSystem|Fcm::ConfigSystem>,
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/ExtractConfigComparator.pm	(revision 9621)
@@ -0,0 +1,83 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::ExtractConfigComparator;
+use base qw{Fcm::CLI::Invoker};
+
+use Cwd qw{cwd};
+use Fcm::ExtractConfigComparator;
+use Fcm::Config;
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my ($cfg_file1, $cfg_file2) = $self->get_arguments();
+    if (exists($self->get_options()->{verbose})) {
+        Fcm::Config->instance()->verbose($self->get_options()->{verbose});
+    }
+
+    my $system = Fcm::ExtractConfigComparator->new({
+        files => [$cfg_file1, $cfg_file2], wiki => $self->get_options()->{wiki},
+    });
+    $system->invoke();
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::ExtractInvoker
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::ExtractConfigComparator;
+    $invoker = Fcm::CLI::Invoker::ExtractConfigComparator->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the extract configuration
+comparator.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the extract configuration comparator.
+
+The I<wiki> option is mapped directly to that of the constructor of
+L<Fcm::ExtractConfigComparator|Fcm::ExtractConfigComparator> object.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::ExtractConfigComparator|Fcm::ExtractConfigComparator>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/GUI.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/GUI.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/GUI.pm	(revision 9621)
@@ -0,0 +1,70 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::GUI;
+use base qw{Fcm::CLI::Invoker};
+
+use Fcm::Util qw{run_command};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my ($target) = $self->get_arguments();
+    run_command(['fcm_gui', ($target ? $target : ())], METHOD => 'exec');
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::GUIInvoker
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::GUI;
+    $invoker = Fcm::CLI::Invoker::GUI->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke($command, \%options, $target);
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the FCM GUI.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the FCM GUI. If a target is specified as argument, it is the initial
+working directory of the GUI.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/Help.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/Help.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/Help.pm	(revision 9621)
@@ -0,0 +1,220 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::Help;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::CLI::Config;
+use Fcm::Config;
+use Fcm::Util qw{run_command};
+use IO::File;
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my @subcommand_names = $self->get_arguments();
+    if (@subcommand_names) {
+        for my $subcommand_name (@subcommand_names) {
+            my $help_string = $self->_get_help_for($subcommand_name);
+            if (!defined($help_string)) {
+                croak(Fcm::CLI::Exception->new({message => sprintf(
+                    "%s: unknown command", $subcommand_name,
+                )}));
+            }
+            print($help_string, "\n");
+        }
+    }
+    else {
+        print($self->_get_help());
+    }
+}
+
+################################################################################
+# Returns the help string for a subcommand matching $subcommand_name
+sub _get_help_for {
+    my ($self, $subcommand_name) = @_;
+    my $subcommand
+        = Fcm::CLI::Config->instance()->get_subcommand_of($subcommand_name);
+    if (!$subcommand) {
+        return;
+    }
+    if ($subcommand->is_vc()) {
+        my $invoker = $subcommand->get_invoker($subcommand_name);
+        local(@ARGV) = '--help';
+        $invoker->invoke();
+        return q{};
+    }
+    my $prog = Fcm::Config->instance()->setting('FCM_COMMAND');
+    # FIXME: can do with using Text::Template or Perl6::Form
+    my $help = sprintf(
+        "%s %s: %s\n",
+        $prog,
+        $subcommand->as_string(),
+        $subcommand->get_synopsis(),
+    );
+    $help .= sprintf(
+        "usage: %s %s %s\n",
+        $prog, $subcommand->get_names()->[0], $subcommand->get_usage(),
+    );
+    if ($subcommand->get_description()) {
+        my @lines = (q{}, split("\n", $subcommand->get_description()), q{});
+        $help .= join(qq{\n  }, @lines) . "\n";
+    }
+    if ($subcommand->get_options()) {
+        $help .= "Valid options:\n";
+        my $max_length_of_name = 0;
+        my @option_names;
+        for my $option ($subcommand->get_options()) {
+            if (length($option->get_name()) > $max_length_of_name) {
+                $max_length_of_name = length($option->get_name());
+            }
+        }
+        for my $option ($subcommand->get_options()) {
+            $help .= sprintf(
+                "  --%s%s%s%s : %s\n",
+                $option->get_name(),
+                q{ } x ($max_length_of_name - length($option->get_name())),
+                (
+                    $option->get_letter()
+                    ? q{ [-} . $option->get_letter() . q{]} : q{     }
+                ),
+                ($option->has_arg() ? q{ arg} : q{ } x 4),
+                $option->get_description(),
+            );
+        }
+    }
+    return $help;
+}
+
+################################################################################
+# Returns the general help string
+sub _get_help {
+    my ($self) = @_;
+    my $release = $self->_get_release();
+
+    # FIXME: can do with using Text::Template or Perl6::Form
+    my $prog = Fcm::Config->instance()->setting('FCM_COMMAND');
+    my $return = sprintf(
+          qq{usage: %s <subcommand> [options] [args]\n}
+        . qq{Flexible configuration management system, release %s.\n}
+        . qq{Type "%s help <subcommand>" for help on a specific subcommand\n}
+        . qq{\n}
+        . qq{Available subcommands:\n}
+        ,
+        $prog, $release, $prog,
+    );
+    for my $subcommand (Fcm::CLI::Config->instance()->get_core_subcommands()) {
+        $return .= sprintf(qq{  %s\n}, $subcommand->as_string());
+    }
+
+    my @lines = run_command(
+        [qw/svn help/], DEVNULL => 1, METHOD => 'qx', ERROR => 'ignore',
+    );
+    if (@lines) {
+        for my $subcommand (Fcm::CLI::Config->instance()->get_vc_subcommands()) {
+            if (defined($subcommand->get_synopsis())) {
+                $return .= sprintf(qq{  %s\n}, $subcommand->as_string());
+            }
+            else {
+                $return .= qq{  <version control system commands, see below>\n};
+            }
+        }
+        $return .= "\n=> svn help\n". join(q{}, @lines);
+    }
+    return $return;
+}
+
+################################################################################
+# Returns the release number of the current program
+sub _get_release {
+    my ($self) = @_;
+    my $release  = Fcm::Config->instance()->setting('FCM_RELEASE');
+    my $rev_file = Fcm::Config->instance()->setting('FCM_REV_FILE');
+    if (-r $rev_file) {
+        my $handle = IO::File->new($rev_file, 'r');
+        if ($handle) {
+            my $rev = $handle->getline();
+            $handle->close();
+            chomp($rev);
+            if ($rev) {
+                $release .= qq{ (r$rev)};
+            }
+        }
+    }
+    return $release;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::Help
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::Help;
+    $invoker = Fcm::CLI::Invoker::Help->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to provide help on the command line
+interface.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Provides help. If a subcommand name is specified in the argument, provides help
+for the specified subcommand. If a subcommand name is not specified, provides
+general CLI help.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method can croak() with this exception if the specified subcommand
+cannot be identified.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+Separate logic in this module with that of L<Fcm::CLI::Config|Fcm::CLI::Config>.
+
+Decouples help formatter with this invoker.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Invoker/KeywordPrinter.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Invoker/KeywordPrinter.pm	(revision 9621)
@@ -0,0 +1,124 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Invoker::KeywordPrinter;
+use base qw{Fcm::CLI::Invoker};
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::Keyword;
+use Fcm::Keyword::Formatter::Entries;
+use Fcm::Keyword::Formatter::Entry::Location;
+use Fcm::Keyword::Exception;
+use Fcm::Util qw{get_url_of_wc};
+
+################################################################################
+# Invokes the sub-system
+sub invoke {
+    my ($self) = @_;
+    my @targets = $self->get_arguments();
+    if (@targets) {
+        for my $target (@targets) {
+            my $entry_list = Fcm::Keyword::get_location_entries_for($target);
+            my $loc = $target;
+            if (-e $target) {
+                $loc = get_url_of_wc($target);
+                if (!$loc) {
+                    croak(Fcm::Keyword::Exception->new({message => sprintf(
+                        "%s: unrecognised version control resource", $target,
+                    )}));
+                }
+            }
+            my @entry_list = Fcm::Keyword::get_location_entries_for($loc);
+            if (!@entry_list) {
+                croak(Fcm::Keyword::Exception->new({message => sprintf(
+                    "%s: no FCM location keyword found for this target", $target,
+                )}));
+            }
+            my $formatter = Fcm::Keyword::Formatter::Entry::Location->new();
+            for my $entry (
+                sort {$a->get_key() cmp $b->get_key()}
+                grep {!$_->is_implied()}
+                @entry_list
+            ) {
+                print($formatter->format($entry), "\n");
+            }
+        }
+    }
+    else {
+        my $formatter = Fcm::Keyword::Formatter::Entries->new();
+        print($formatter->format(Fcm::Keyword::get_entries()));
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Invoker::KeywordPrinter
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Invoker::KeywordPrinter;
+    $invoker = Fcm::CLI::Invoker::KeywordPrinter->new({
+        command   => $command,
+        options   => \%options,
+        arguments => $arguments,
+    });
+    $invoker->invoke();
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> an inherits all its
+methods. An object of this class is used to invoke the location keyword printer.
+
+=head1 METHODS
+
+See L<Fcm::CLI::Invoker|Fcm::CLI::Invoker> for a list of inherited methods.
+
+=over 4
+
+=item invoke()
+
+Invokes the location keyword printer. If a namespace is specified in the
+argument, prints revision keywords and browser mapping templates for the
+specified namespace. If a namespace is not specified, prints all registered
+location keywords.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+The invoke() method can croak() with this exception if there is no matching
+namespace matching that of the specified.
+
+=back
+
+=head1 TO DO
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Subcommand|Fcm::CLI::Subcommand>,
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Formatter::Entries|Fcm::Keyword::Formatter::Entries>,
+L<Fcm::Keyword::Formatter::Entry::Location|Fcm::Keyword::Formatter::Entry::Location>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Option.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Option.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Option.pm	(revision 9621)
@@ -0,0 +1,183 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Option;
+
+use constant NO_ARG     => 0;
+use constant SCALAR_ARG => 1;
+use constant ARRAY_ARG  => 2;
+use constant HASH_ARG   => 3;
+use constant ARG_STRING_SUFFIX_FOR => (q{}, q{=s}, q{=s@}, q{=s%});
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    # Returns the delimiter of this option, if it is an array
+    'delimiter',
+    # Returns the description of this option
+    'description',
+    # Returns the (long) name of this option
+    'name',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Returns the letter of this option
+sub get_letter {
+    my ($self) = @_;
+    if (defined($self->{letter})) {
+        return substr($self->{letter}, 0, 1);
+    }
+    else {
+        return;
+    }
+}
+
+################################################################################
+# Returns whether the current option has no, scalar, array or hash arguments
+sub has_arg {
+    my ($self) = @_;
+    return (defined($self->{has_arg}) ? $self->{has_arg} : $self->NO_ARG);
+}
+
+################################################################################
+# Returns true if this option is associated with help
+sub is_help {
+    my ($self) = @_;
+    return $self->{is_help};
+}
+
+################################################################################
+# Returns an option string/reference pair for Getopt::Long::GetOptions
+sub get_arg_for_getopt_long {
+    my ($self) = @_;
+    my $option_string
+        = $self->get_name()
+          . ($self->get_letter() ? q{|} . $self->get_letter() : q{})
+          . (ARG_STRING_SUFFIX_FOR)[$self->has_arg()]
+          ;
+    return $option_string;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Option
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Option;
+    $option = Fcm::CLI::Option->new({
+        name        => 'name',
+        letter      => 'n',
+        has_arg     => Fcm::CLI::Option->SCALAR_ARG,
+        is_help     => 1,
+        description => 'an example option',
+    });
+
+    # time passes ...
+    use Getopt::Long qw{GetOptions};
+    $success = GetOptions(
+        \%hash,
+        $option->get_arg_for_getopt_long(), # ('name|n=s')
+        # and other options ...
+    );
+    $option_value = $option->get_value();
+
+=head1 DESCRIPTION
+
+An object of this class represents a CLI option.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor.
+
+=item get_arg_for_getopt_long()
+
+Returns an option string for this option that is suitable for use as arguments
+to L<Getopt::Long|Getopt::Long>.
+
+=item get_description()
+
+Returns a description of this option.
+
+=item get_delimiter()
+
+Returns the delimiter of this option. This is only relevant if has_arg() is
+equal to C<ARRAY_ARG>. If set, the argument for this option should be re-grouped
+using this delimiter.
+
+=item get_name()
+
+Returns the (long) name of this option.
+
+=item get_letter()
+
+Returns the option letter of this option.
+
+=item has_arg()
+
+Returns whether this option has no, scalar, array or hash arguments. See
+L</CONSTANTS> for detail.
+
+=item is_help()
+
+Returns true if this option is associated with help.
+
+=back
+
+=head1 CONSTANTS
+
+=over 4
+
+=item NO_ARG
+
+An option has no argument. (Default)
+
+=item SCALAR_ARG
+
+An option has a single scalar argument.
+
+=item ARRAY_ARG
+
+An option has multiple arguments, which can be placed in an array.
+
+=item HASH_ARG
+
+An option has multiple arguments, which can be placed in an hash.
+
+=back
+
+=head1 SEE ALSO
+
+L<Getopt::Long|Getopt::Long>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/Subcommand.pm
===================================================================
--- vendors/FCM/lib/Fcm/CLI/Subcommand.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/Subcommand.pm	(revision 9621)
@@ -0,0 +1,245 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::CLI::Subcommand;
+
+use Carp qw{croak};
+use Fcm::CLI::Exception;
+use Fcm::Util::ClassLoader;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    # Returns the long description of this subcommand
+    'description',
+    # Returns the class of the invoker of this subcommand
+    'invoker_class',
+    # Returns the extra config to be given to the invoker of this subcommand
+    'invoker_config',
+    # Returns the names of this subcommand
+    'names',
+    # Returns the options of this subcommand
+    'options',
+    # Returns the synopsis of this subcommand
+    'synopsis',
+    # Returns the usage of this subcommand
+    'usage',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        if (defined($self->{$key})) {
+            if (ref($self->{$key}) eq 'ARRAY') {
+                return (wantarray() ? @{$self->{$key}} : $self->{$key});
+            }
+            else {
+                return $self->{$key};
+            }
+        }
+        else {
+            return;
+        }
+    }
+}
+
+################################################################################
+# Returns true if this subcommand represents a command in the CM sub-system
+sub is_vc {
+    my ($self) = @_;
+    return $self->{is_vc};
+}
+
+################################################################################
+# Returns true if $string matches a name of this subcommand
+sub has_a_name {
+    my ($self, $string) = @_;
+    if ($self->get_names() && ref($self->get_names()) eq 'ARRAY') {
+        my %name_of = map {$_, 1} @{$self->get_names()};
+        return exists($name_of{$string});
+    }
+    else {
+        return;
+    }
+}
+
+################################################################################
+# Invokes this subcommand based on current @ARGV
+sub get_invoker {
+    my ($self, $command) = @_;
+    my %options = ();
+    if (($self->get_options())) {
+        my $problem = q{};
+        local($SIG{__WARN__}) = sub {
+            ($problem) = @_;
+        };
+        my $success = GetOptions(
+            \%options,
+            (map {$_->get_arg_for_getopt_long()} ($self->get_options())),
+        );
+        if (!$success) {
+            croak(Fcm::CLI::Exception->new({message => sprintf(
+                "%s: option parse failed: %s", $command, $problem,
+            )}));
+        }
+    }
+    my $invoker_class
+        = $self->get_invoker_class() ? $self->get_invoker_class()
+        :                              'Fcm::CLI::Invoker'
+        ;
+    Fcm::Util::ClassLoader::load($invoker_class);
+    my $invoker = $invoker_class->new({
+        command   => $command,
+        options   => \%options,
+        arguments => [@ARGV],
+    });
+    return $invoker;
+}
+
+################################################################################
+# Returns a simple string representation of this subcommand
+sub as_string {
+    my ($self) = @_;
+    # FIXME: can do with using Text::Template or Perl6::Form
+    if (
+           $self->get_names()
+        && ref($self->get_names()) eq 'ARRAY'
+        && @{$self->get_names()}
+    ) {
+        my @names = $self->get_names();
+        my $return = $names[0];
+        for my $i (1 .. $#names) {
+            if ($names[$i]) {
+                $return
+                    .= $i == 1       ? q{ (} . $names[$i]
+                    :                  q{, } . $names[$i]
+                    ;
+            }
+            if ($i == $#names) {
+                $return .= q{)};
+            }
+        }
+        return $return;
+    }
+    else {
+        return q{};
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::CLI::Subcommand
+
+=head1 SYNOPSIS
+
+    use Fcm::CLI::Subcommand;
+    $subcommand = Fcm::CLI::Subcommand->new({
+        names          => ['build', 'bld'],
+        options        => [
+            Fcm::CLI::Option->new(
+                # ... some arguments ...
+            ),
+            # ... more options
+        ],
+        synopsis       => 'invokes the build system',
+        description    => $description,
+        usage          => '[OPTIONS] [CONFIG]',
+        invoker_class  => $invoker_class,
+        invoker_config => {
+            option1 => $option1,
+            # ... more options
+        },
+    });
+    $boolean = $subcommand->has_a_name($string);
+    $invoker_class = $subcommand->get_invoker_class();
+
+=head1 DESCRIPTION
+
+An object of this class is used to store the configuration of a subcommand of
+the FCM CLI.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor.
+
+=item get_description()
+
+Returns the long description of this subcommand.
+
+=item get_invoker_class()
+
+Returns the invoker class of this subcommand, which should be a sub-class of
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>.
+
+=item get_invoker_cconfig()
+
+Returns a reference to a hash containing the extra configuration to be given to
+the constructor of the invoker of this subcommand.
+
+=item get_names()
+
+Returns an array containing the names of this subcommand.
+
+=item get_options()
+
+Returns an array containing the options of this subcommand. Each element of
+the array should be a L<Fcm::CLI::Option|Fcm::CLI::Option> object.
+
+=item get_synopsis()
+
+Returns a short synopsis of this subcommand.
+
+=item get_usage()
+
+Returns a short usage statement of this subcommand.
+
+=item is_vc()
+
+Returns true if this subcommand represents commands in the underlying VC system.
+
+=item has_a_name($string)
+
+Returns true if a name in C<$self-E<gt>get_names()> matches $string.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::CLI::Exception|Fcm::CLI::Exception>
+
+The invoke() method may croak() with this exception.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::CLI::Exception|Fcm::CLI::Exception>,
+L<Fcm::CLI::Invoker|Fcm::CLI::Invoker>,
+L<Fcm::CLI::Option|Fcm::CLI::Option>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-add.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-add.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-add.pod	(revision 9621)
@@ -0,0 +1,22 @@
+=head1 NAME
+
+fcm add
+
+=head1 SYNOPSIS
+
+    fcm add [options] [args]
+
+=head1 OPTIONS
+
+=over 4
+
+=item -c [--check]
+
+Check for any files or directories reported by "L<svn|svn> status" as not under
+version control and add them.
+
+=back
+
+For other options, see output of "L<svn|svn> help add".
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-branch.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-branch.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-branch.pod	(revision 9621)
@@ -0,0 +1,173 @@
+=head1 NAME
+
+fcm branch (br)
+
+=head1 SYNOPSIS
+
+Create, delete or display information of a branch, or list branches in a
+project.
+
+    fcm branch [--info] [OPTIONS] [TARGET]
+    fcm branch --delete [OPTIONS] [TARGET]
+    fcm branch --create [OPTIONS] [SOURCE]
+    fcm branch --list   [OPTIONS] [SOURCE]
+
+=head1 ARGUMENTS
+
+TARGET (and SOURCE) can be an URL or a Subversion working copy. Otherwise,
+the current working directory must be a working copy. For --info and
+--delete, the specified URL (or the URL of the working copy) must be a URL
+under a valid branch in a standard FCM project. For --create and --list, it
+must be a URL under a standard FCM project.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --info or -i
+
+Display information about a branch. This is the default option if --create,
+--delete and --list are not specified.
+
+=item --delete or -d
+
+Delete a branch.
+
+=item --create or -c
+
+Create a new branch from SOURCE. The --name option must be used to specify a
+short name for the new branch.
+
+=item --list or -l
+
+List all the branches owned by the current user in SOURCE. If the --user option
+is specified with a list of users, list all the branches owned by these users
+instead of the current user.
+
+=back
+
+Valid options with --info and --delete:
+
+=over 4
+
+=item -v [--verbose]
+
+Print extra information.
+
+=item -a [--show-all]
+
+Set --show-children, --show-other and --show-siblings.
+
+=item --show-children
+
+Report children of the current branch.
+
+=item --show-other
+
+Report custom/ reverse merges into the current branch.
+
+=item --show-siblings
+
+Report merges with siblings of the current branch.
+
+=back
+
+Valid options with --delete and --create:
+
+=over 4
+
+=item --non-interactive
+
+Do no interactive prompting. This option implies --svn-non-interactive.
+
+=item --password arg
+
+Specify a password for write access to the repository.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time. This option is implied by
+--non-interactive.
+
+=back
+
+Valid options with --create and --list:
+
+=over 4
+
+=item -r [--revision] arg
+
+Specify the operative revision of the SOURCE for creating the branch.
+
+=back
+
+Valid options with --create:
+
+=over 4
+
+=item --branch-of-branch
+
+If this option is specified and the SOURCE is a branch, it will create a new
+branch from the SOURCE branch. Otherwise, the branch is created from the trunk.
+
+=item -k [--ticket] arg
+
+Specify one (or more) Trac ticket. If specified, the command will add to the
+commit log the line "Relates to ticket #<ticket>". Multiple tickets can be set
+by specifying this option multiple times, or by specifying the tickets in a
+comma-separated list.
+
+=item -n [--name] arg
+
+Specify a short name for the branch, which should contain only characters in the
+set [A-Za-z0-9_-.].
+
+=item --rev-flag arg
+
+Specify a flag for determining the prefix of the branch name. The flag can be
+the the string "NORMAL", "NUMBER" or "NONE".  "NORMAL" is the default behaviour,
+in which the branch name will be prefixed with a Subversion revision number if
+the revision is not associated with a registered FCM revision keyword. If the
+revision is registered with a FCM revision keyword, the keyword will be used in
+place of the number. If "NUMBER" is specified, the branch name will always be
+prefixed with a Subversion revision number. If "NONE" is specified, the branch
+name will not be prefixed by a revision number or keyword.
+
+=item -t [--type] arg
+
+Specify the type of the branch to be created. It must be one of the following:
+
+ DEV::USER [DEV, USER] - a development branch for the user
+ DEV::SHARE [SHARE]    - a shared development branch
+ TEST::USER [TEST]     - a test branch for the user
+ TEST::SHARE           - a shared test branch
+ PKG::USER [PKG]       - a package branch for the user
+ PKG::SHARE            - a shared package branch
+ PKG::CONFIG [CONFIG]  - a configuration branch
+ PKG::REL [REL]        - a release branch
+
+If not specified, the default is to create a development branch for the current
+user, i.e.  DEV::USER.
+
+=back
+
+Valid options with --list:
+
+=over 4
+
+=item -a [--show-all]
+
+Print all branches.
+
+=item -u [--user] arg
+
+Specify a colon-separated list of users. List branches owned by these users
+instead of the current user.
+
+=item -v [--verbose]
+
+Print Subversion URL instead of FCM URL keywords.
+
+=back
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-commit.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-commit.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-commit.pod	(revision 9621)
@@ -0,0 +1,31 @@
+=head1 NAME
+
+fcm commit (ci)
+
+=head1 SYNOPSIS
+
+    fcm commit [OPTIONS] [PATH ...]
+
+Send changes from your working copy to the repository. Invoke your favourite
+editor to prompt you for a commit log message. Update your working copy
+following the commit.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dry-run
+
+Allows you to add to the commit message without committing.
+
+=item --svn-non-interactive
+
+Do no interactive prompting at commit time.
+
+=item --password arg
+
+Specify a password ARG.
+
+=back
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-conflicts.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-conflicts.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-conflicts.pod	(revision 9621)
@@ -0,0 +1,17 @@
+=head1 NAME
+
+fcm conflicts (cf)
+
+=head1 SYNOPSIS
+
+Use graphical tool to resolve any conflicts within your working copy.
+
+    fcm conflicts [PATH]
+
+=head1 ARGUMENTS
+
+Invoke a graphical merge tool to help you resolve conflicts in your working copy
+at PATH. It prompts you to run "L<svn|svn> resolved" each time you have resolved
+the conflicts in a text file.
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-delete.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-delete.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-delete.pod	(revision 9621)
@@ -0,0 +1,22 @@
+=head1 NAME
+
+fcm delete (del, remove, rm)
+
+=head1 SYNOPSIS
+
+    fcm delete [options] [args]
+
+=head1 OPTIONS
+
+=over 4
+
+=item -c [--check]
+
+Check for any files or directories reported by "L<svn|svn> status" as missing
+and schedule them for removal.
+
+=back
+
+For other options, see output of "L<svn|svn> help delete".
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-diff.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-diff.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-diff.pod	(revision 9621)
@@ -0,0 +1,79 @@
+=head1 NAME
+
+fcm diff (di)
+
+=head1 SYNOPSIS
+
+    1. fcm diff --branch [OPTIONS] [TARGET]
+    2. fcm diff [OPTIONS] [ARGS]
+
+=over 4
+
+=item 1.
+
+Show differences relative to the base of the target branch, i.e. the changes
+available for merging from the target branch into its parent. If TARGET is
+specified, it must either be a URL or a working copy.  Otherwise, the target is
+the the current directory which must be a working copy. The target URL must be a
+branch in a standard FCM project.
+
+=item 2.
+
+See description of "L<svn|svn> diff" below.
+
+=back
+
+=head1 OPTIONS
+
+Valid options with --branch:
+
+=over 4
+
+=item --diff-cmd arg
+
+As described below in the help for "L<svn|svn> diff".
+
+=item -g [--graphical]
+
+As described below.
+
+=item --summarise
+
+As described below
+
+=item --summarize
+
+As described below in the help for "L<svn|svn> diff".
+
+=item -t [--trac]
+
+If TARGET is a URL, use Trac to display the diff.
+
+=item --wiki
+
+If TARGET is a URL, print Trac link for the diff.
+
+=item -x [--extensions] arg
+
+As described below in the help for "L<svn|svn> diff".
+
+=back
+
+Other options:
+
+=over 4
+
+=item -g [--graphical]
+
+Use a graphical diff tool to display the differences. This option should not be
+used in combination with --diff-cmd.
+
+=item --summarise
+
+Same as --summarize as described below.
+
+=back
+
+For other options, see output of "L<svn|svn> help diff".
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-merge.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-merge.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-merge.pod	(revision 9621)
@@ -0,0 +1,71 @@
+=head1 NAME
+
+fcm merge
+
+=head1 SYNOPSIS
+
+Merge changes from a source into your working copy.
+
+    1. fcm merge SOURCE
+    2. fcm merge --custom  --revision N[:M] SOURCE
+       fcm merge --custom  URL[\@REV1] URL[\@REV2]
+    3. fcm merge --reverse --revision [M:]N
+
+=over 4
+
+=item 1.
+
+If neither --custom nor --reverse is specified, the command merges changes
+automatically from SOURCE into your working copy. SOURCE must be a valid
+URL[@REV] of a branch in a standard FCM project. The base of the merge will be
+calculated automatically based on the common ancestor and latest merge
+information between the SOURCE and the branch of the working copy.
+
+=item 2.
+
+If --custom is specified, the command can be used in two forms.
+  
+In the first form, it performs a custom merge from the specified changeset(s) of
+SOURCE into your working copy. SOURCE must be a valid URL[@REV] of a branch in
+a standard FCM project. If a single revision is specified, the merge delta is (N
+- 1):N of SOURCE. Otherwise, the merge delta, is N:M of SOURCE, where N < M.
+     
+In the second form, it performs a custom merge using the delta between the two
+specified branch URLs. For each URL, if a peg revision is not specified, the
+command will peg the URL with its last changed revision.
+
+=item 3.
+
+If --reverse is specified, the command performs a reverse merge of the
+changeset(s) specified by the --revision option. If a single revision is
+specified, the merge delta is N:(N - 1). Otherwise, the merge delta is M:N,
+where M > N. Note that you do not have to specify a SOURCE for a reverse merge,
+because the SOURCE should always be the branch your working copy is pointing to.
+  
+=back
+
+The command provide a commit log message template following the merge.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dry-run
+
+Try operation but make no changes.
+
+=item --non-interactive
+
+Do no interactive prompting.
+
+=item -r [--revision] arg
+
+Specify a (range of) revision number(s).
+
+=item --verbose
+
+Print extra information.
+
+=back
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-mkpatch.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-mkpatch.pod	(revision 9621)
@@ -0,0 +1,60 @@
+=head1 NAME
+
+fcm mkpatch
+
+=head1 SYNOPSIS
+
+mkpatch: Create patches from specified revisions of a URL
+
+    fcm mkpatch [OPTIONS] URL [OUTDIR]
+
+Create patches from specified revisions of the specified URL. If OUTDIR is
+specified, the output is sent to OUTDIR. Otherwise, the output will be sent to a
+default location in the current directory ($PWD/fcm-mkpatch-out). The output
+directory will contain the patch for each revision as well as a script for
+importing the patch.
+
+A warning is given if the URL is not of a branch in a FCM project or if it is a
+sub-directory of a branch.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --exclude arg
+
+Exclude a path in the URL. Multiple paths can be specified by using a
+colon-separated list of paths, or by specifying this option multiple times.
+
+The specified path must be a relative path of the URL. Glob patterns such as *
+and ? are acceptable. Changes in an excluded path will not be considered in the
+patch. A changeset containing changes only in the excluded path will not be
+considered at all.
+
+=item --organisation arg
+
+This option can be used to specify the name of your organisation.
+
+The command will attempt to parse the commit log message for each revision in
+the patch. It will remove all merge templates, replace Trac links with a
+modified string, and add information about the original changeset. If you
+specify the name of your organisation, it will replace Trac links such as
+"ticket:123" with "$organisation_ticket:123", and report the original changeset
+with a message such as "$organisation_changeset:1000".  If the organisation
+name is not specified then it defaults to "original".
+
+=item -r [--revision] arg
+
+Specify a revision number or a revision number range.
+
+If a revision is specified with the --revision option, it will attempt to create
+a patch based on the changes at that revision. If a revision is not specified,
+it will attempt to create a patch based on the changes at the HEAD revision. If
+a revision range is specified, it will attempt to create a patch for each
+revision in that range (including the change in the lower range) where changes
+have taken place in the URL. No output will be written if there is no change in
+the given revision (range).
+
+=back
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-switch.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-switch.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-switch.pod	(revision 9621)
@@ -0,0 +1,14 @@
+=head1 NAME
+
+fcm switch (sw)
+
+=head1 SYNOPSIS
+
+    1. switch URL [PATH]
+    2. switch --relocate FROM TO [PATH...]
+
+Note: if --relocate is not specified, "fcm switch" will only support the options
+--non-interactive, -r [--revision] and -q [--quiet]. For detail, see the output
+of "L<svn|svn> help switch".
+
+=cut
Index: vendors/FCM/lib/Fcm/CLI/fcm-update.pod
===================================================================
--- vendors/FCM/lib/Fcm/CLI/fcm-update.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/CLI/fcm-update.pod	(revision 9621)
@@ -0,0 +1,14 @@
+=head1 NAME
+
+fcm update (up)
+
+=head1 SYNOPSIS
+
+Bring changes from the repository into the working copy.
+
+    usage: update [PATH...]
+
+Note: "fcm update" only supports --non-interactive, -r [--revision] arg and -q
+[--quiet]. For detail, see the output of "L<svn|svn> help update".
+
+=cut
Index: vendors/FCM/lib/Fcm/CfgFile.pm
===================================================================
--- vendors/FCM/lib/Fcm/CfgFile.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CfgFile.pm	(revision 9621)
@@ -0,0 +1,679 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgFile
+#
+# DESCRIPTION
+#   This class is used for reading and writing FCM config files. A FCM config
+#   file is a line-based text file that provides information on how to perform
+#   a particular task using the FCM system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgFile;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Basename;
+use File::Path;
+use File::Spec;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::CfgLine;
+use Fcm::Config;
+use Fcm::Keyword;
+use Fcm::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'actual_src', # actual source of configuration file
+  'lines',      # list of lines, Fcm::CfgLine objects
+  'pegrev',     # peg revision of configuration file
+  'src',        # source of configuration file
+  'type',       # type of configuration file
+  'version',    # version of configuration file
+);
+
+# Local module variables
+my $expand_type   = 'bld|ext'; # config file type that needs variable expansions
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::CfgFile->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgFile class. See above
+#   for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  bless $self, $class;
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    if (not defined $self->{$name}) {
+      if ($name eq 'lines') {
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mtime = $obj->mtime ();
+#
+# DESCRIPTION
+#   This method returns the modified time of the configuration file source.
+# ------------------------------------------------------------------------------
+
+sub mtime {
+  my $self  = shift;
+  my $mtime = undef;
+
+  if (-f $self->src) {
+    $mtime = (stat $self->src)[9];
+  }
+
+  return $mtime;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $read = $obj->read_cfg ();
+#
+# DESCRIPTION
+#   This method reads the current configuration file. It returns the number of
+#   lines read from the config file, or "undef" if it fails. The result is
+#   placed in the LINES array of the current instance, and can be accessed via
+#   the "lines" method.
+# ------------------------------------------------------------------------------
+
+sub read_cfg {
+  my $self = shift;
+
+  my @lines = $self->_get_cfg_lines;
+
+  # List of CFG types that need INC declarations expansion
+  my %exp_inc    = ();
+  for (split (/$Fcm::Config::DELIMITER_LIST/, $self->setting ('CFG_EXP_INC'))) {
+    $exp_inc{uc ($_)} = 1;
+  }
+
+  # List of CFG labels that are reserved keywords
+  my %cfg_keywords = ();
+  for (split (/$Fcm::Config::DELIMITER_LIST/, $self->setting ('CFG_KEYWORD'))) {
+    $cfg_keywords{$self->cfglabel ($_)} = 1;
+  }
+
+  # Loop each line, to separate lines into label : value pairs
+  my $cont = undef;
+  my $here = undef;
+  for my $line_num (1 .. @lines) {
+    my $line = $lines[$line_num - 1];
+    chomp $line;
+
+    my $label   = '';
+    my $value   = '';
+    my $comment = '';
+
+    # If this line is a continuation, set $start to point to the line that
+    # starts this continuation. Otherwise, set $start to undef
+    my $start = defined ($cont) ? $self->lines->[$cont] : undef;
+    my $warning = undef;
+
+    if ($line =~ /^(\s*#.*)$/) { # comment line
+      $comment = $1;
+
+    } elsif ($line =~ /\S/) {    # non-blank line
+      if (defined $cont) {
+        # Previous line has a continuation mark
+        $value = $line;
+
+        # Separate value and comment
+        if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+          $comment = $1;
+        }
+
+        # Remove leading spaces
+        $value =~ s/^\s*\\?//;
+
+        # Expand environment variables
+        my $warn;
+        ($value, $warn) = $self->_expand_variable ($value, 1) if $value;
+        $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+        # Expand internal variables
+        ($value, $warn) = $self->_expand_variable ($value, 0) if $value;
+        $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+        # Get "line" that begins the current continuation
+        my $v = $start->value . $value;
+        $v =~ s/\\$//;
+        $start->value ($v);
+
+      } else {
+        # Previous line does not have a continuation mark
+        if ($line =~ /^\s*(\S+)(?:\s+(.*))?$/) {
+          # Check line contains a valid label:value pair
+          $label = $1;
+          $value = defined ($2) ? $2 : '';
+
+          # Separate value and comment
+          if ($value =~ s/((?:\s+|^)#\s+.*)$//) {
+            $comment = $1;
+          }
+
+          # Remove trailing spaces
+          $value =~ s/\s+$//;
+
+          # Value begins with $HERE?
+          $here  = ($value =~ /\$\{?HERE\}?(?:[^A-Z_]|$)/);
+
+          # Expand environment variables
+          my $warn;
+          ($value, $warn) = $self->_expand_variable ($value, 1) if $value;
+          $warning .= ($warning ? ', ' : '') . $warn if $warn;
+
+          # Expand internal variables
+          ($value, $warn) = $self->_expand_variable ($value, 0) if $value;
+          $warning .= ($warning ? ', ' : '') . $warn if $warn;
+        }
+      }
+
+      # Determine whether current line ends with a continuation mark
+      if ($value =~ s/\\$//) {
+        $cont = scalar (@{ $self->lines }) unless defined $cont;
+
+      } else {
+        $cont = undef;
+      }
+    }
+
+    if (exists $exp_inc{uc ($self->type)} and
+        uc ($start ? $start->label : $label) eq $self->cfglabel ('INC') and
+        not defined $cont) {
+      # Current configuration file requires expansion of INC declarations
+      # The start/current line is an INC declaration
+      # The current line is not a continuation or is the end of the continuation
+
+      # Get lines from an "include" configuration file
+      my $src = ($start ? $start->value : $value);
+      $src   .= '@' . $self->pegrev if $here and $self->pegrev;
+
+      if ($src) {
+        # Invoke a new instance to read the source
+        my $cfg = Fcm::CfgFile->new (
+          SRC => expand_tilde ($src), TYPE => $self->type,
+        );
+
+        $cfg->read_cfg;
+
+        # Add lines to the lines array in the current configuration file
+        $comment = 'INC ' . $src . ' ';
+        push @{$self->lines}, Fcm::CfgLine->new (
+          comment => $comment . '# Start',
+          number  => ($start ? $start->number : $line_num),
+          src     => $self->actual_src,
+          warning => $warning,
+        );
+        push @{ $self->lines }, @{ $cfg->lines };
+        push @{$self->lines}, Fcm::CfgLine->new (
+          comment => $comment . '# End',
+          src     => $self->actual_src,
+        );
+
+      } else {
+        push @{$self->lines}, Fcm::CfgLine->new (
+          number  => $line_num,
+          src     => $self->actual_src,
+          warning => 'empty INC declaration.'
+        );
+      }
+
+    } else {
+      # Push label:value pair into lines array
+      push @{$self->lines}, Fcm::CfgLine->new (
+        label   => $label,
+        value   => ($label ? $value : ''),
+        comment => $comment,
+        number  => $line_num,
+        src     => $self->actual_src,
+        warning => $warning,
+      );
+    }
+
+    next if defined $cont; # current line not a continuation
+
+    my $slabel = ($start ? $start->label : $label);
+    my $svalue = ($start ? $start->value : $value);
+    next unless $slabel;
+
+    # Check config file type and version
+    if (index (uc ($slabel), $self->cfglabel ('CFGFILE')) == 0) {
+      my @words = split /$Fcm::Config::DELIMITER_PATTERN/, $slabel;
+      shift @words;
+
+      my $name = @words ? lc ($words[0]) : 'type';
+
+      if ($self->can ($name)) {
+        $self->$name ($svalue);
+      }
+    }
+
+    # Set internal variable
+    $slabel =~ s/^\%//; # Remove leading "%" from label
+
+    $self->config->variable ($slabel, $svalue)
+      unless exists $cfg_keywords{$slabel};
+  }
+
+  # Report and reset warnings
+  # ----------------------------------------------------------------------------
+  for my $line (@{ $self->lines }) {
+    w_report $line->format_warning if $line->warning;
+    $line->warning (undef);
+  }
+
+  return @{ $self->lines };
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->print_cfg ($file, [$force]);
+#
+# DESCRIPTION
+#   This method prints the content of current configuration file. If no
+#   argument is specified, it prints output to the standard output. If $file is
+#   specified, and is a writable file name, the output is sent to the file.  If
+#   the file already exists, its content is compared to the current output.
+#   Nothing will be written if the content is unchanged unless $force is
+#   specified. Otherwise, for typed configuration files, the existing file is
+#   renamed using a prefix that contains its last modified time. The method
+#   returns 1 if there is no error.
+# ------------------------------------------------------------------------------
+
+sub print_cfg {
+  my ($self, $file, $force) = @_;
+
+  # Count maximum number of characters in the labels, (for pretty printing)
+  my $max_label_len = 0;
+  for my $line (@{ $self->lines }) {
+    next unless $line->label;
+    my $label_len  = length $line->label;
+    $max_label_len = $label_len if $label_len > $max_label_len;
+  }
+
+  # Output string
+  my $out = '';
+
+  # Append each line of the config file to the output string
+  for my $line (@{ $self->lines }) {
+    $out .= $line->print_line ($max_label_len - length ($line->label) + 1);
+    $out .= "\n";
+  }
+
+  if ($out) {
+    my $old_select = select;
+
+    # Open file if necessary
+    if ($file) {
+      # Make sure the host directory exists and is writable
+      my $dirname = dirname $file;
+      if (not -d $dirname) {
+        print 'Make directory: ', $dirname, "\n" if $self->verbose;
+        mkpath $dirname;
+      }
+      croak $dirname, ': cannot write to config file directory, abort'
+        unless -d $dirname and -w $dirname;
+
+      if (-f $file and not $force) {
+        if (-r $file) {
+          # Read old config file to see if content has changed
+          open IN, '<', $file or croak $file, ': cannot open (', $!, '), abort';
+          my $in_lines = '';
+          while (my $line = <IN>) {
+            $in_lines .= $line;
+          }
+          close IN or croak $file, ': cannot close (', $!, '), abort';
+
+          # Return if content is up-to-date
+          if ($in_lines eq $out) {
+            print 'No change in ', lc ($self->type), ' cfg: ', $file, "\n"
+              if $self->verbose > 1 and $self->type;
+            return 1;
+          }
+        }
+
+        # If config file already exists, make sure it is writable
+        if (-w $file) {
+          if ($self->type) {
+            # Existing config file writable, rename it using its time stamp
+            my $mtime = (stat $file)[9];
+            my ($sec, $min, $hour, $mday, $mon, $year) = (gmtime $mtime)[0 .. 5];
+            my $timestamp = sprintf '%4d%2.2d%2.2d_%2.2d%2.2d%2.2d_',
+                            $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+            my $oldfile   = File::Spec->catfile (
+              $dirname, $timestamp . basename ($file)
+            );
+            rename $file, $oldfile;
+            print 'Rename existing ', lc ($self->type), ' cfg: ',
+                  $oldfile, "\n" if $self->verbose > 1;
+          }
+
+        } else {
+          # Existing config file not writable, throw an error
+          croak $file, ': config file not writable, abort';
+        }
+      }
+
+      # Open file and select file handle
+      open OUT, '>', $file
+        or croak $file, ': cannot open config file (', $!, '), abort';
+      select OUT;
+    }
+
+    # Print output
+    print $out;
+
+    # Close file if necessary
+    if ($file) {
+      select $old_select;
+      close OUT or croak $file, ': cannot close config file (', $!, '), abort';
+
+      if ($self->type and $self->verbose > 1) {
+        print 'Generated ', lc ($self->type), ' cfg: ', $file, "\n";
+
+      } elsif ($self->verbose > 2) {
+        print 'Generated cfg: ', $file, "\n";
+      }
+    }
+
+  } else {
+    # Warn if nothing to print
+    my $warning = 'Empty configuration';
+    $warning   .= ' - nothing written to file: ' . $file if $file;
+    carp $warning if $self->type;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @lines = $self->_get_cfg_lines ();
+#
+# DESCRIPTION
+#   This internal method reads from a configuration file residing in a
+#   Subversion repository or in the normal file system.
+# ------------------------------------------------------------------------------
+
+sub _get_cfg_lines {
+  my $self  = shift;
+  my @lines = ();
+
+  my $verbose = $self->verbose;
+
+  my ($src) = $self->src();
+  if ($src =~ qr{\A([A-Za-z][\w\+-\.]*):}xms) { # is a URI
+    $src = Fcm::Keyword::expand($src);
+    # Config file resides in a SVN repository
+    # --------------------------------------------------------------------------
+    # Set URL source and version
+    my $rev = 'HEAD';
+
+    # Extract version from source if it exists
+    if ($src =~ s{\@ ([^\@]+) \z}{}xms) {
+      $rev = $1;
+    }
+
+    $src = Fcm::Util::tidy_url($src);
+
+    # Check whether URL is a config file
+    my $rc;
+    my @cmd = (qw/svn cat/, $src . '@' . $rev);
+    @lines = &run_command (
+      \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+    );
+
+    # Error in "svn cat" command
+    if ($rc) {
+      # See whether specified config file is a known type
+      my %cfgname = %{ $self->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      # If config file is a known type, specified URL may be a directory
+      if ($file) {
+        # Check whether a config file with a default name exists in the URL
+        my $path = $src . '/' . $file;
+        my @cmd  = (qw/svn cat/, $path . '@' . $rev);
+
+        @lines = &run_command (
+          \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+        );
+
+        # Check whether a config file with a default name exists under the "cfg"
+        # sub-directory of the URL
+        if ($rc) {
+          my $cfgdir = $self->setting (qw/DIR CFG/);
+          $path   = $src . '/' . $cfgdir . '/' . $file;
+          my @cmd = (qw/svn cat/, $path . '@' . $rev);
+
+          @lines  = &run_command (
+            \@cmd, METHOD => 'qx', DEVNULL => 1, RC => \$rc, ERROR => 'ignore',
+          );
+        }
+
+        $src = $path unless $rc;
+      }
+    }
+
+    if ($rc) {
+      # Error in "svn cat"
+      croak 'Unable to locate config file from "', $self->src, '", abort';
+
+    } else {
+      # Print diagnostic, if necessary
+      if ($verbose and $self->type and $self->type =~ /$expand_type/) {
+        print 'Config file (', $self->type, '): ', $src;
+        print '@', $rev if $rev;
+        print "\n";
+      }
+    }
+
+    # Record the actual source location
+    $self->pegrev ($rev);
+    $self->actual_src ($src);
+
+  } else {
+    # Config file resides in the normal file system
+    # --------------------------------------------------------------------------
+    my $src = $self->src;
+
+    if (-d $src) { # Source is a directory
+      croak 'Config file "', $src, '" is a directory, abort' if not $self->type;
+
+      # Get name of the config file by looking at the type
+      my %cfgname = %{ $self->setting ('CFG_NAME') };
+      my $key     = uc $self->type;
+      my $file    = exists $cfgname{$key} ? $cfgname{$key} : '';
+
+      if ($file) {
+        my $cfgdir = $self->setting (qw/DIR CFG/);
+
+        # Check whether a config file with a default name exists in the
+        # specified path, then check whether a config file with a default name
+        # exists under the "cfg" sub-directory of the specified path
+        if (-f File::Spec->catfile ($self->src, $file)) {
+          $src = File::Spec->catfile ($self->src, $file);
+
+        } elsif (-f File::Spec->catfile ($self->src, $cfgdir, $file)) {
+          $src = File::Spec->catfile ($self->src, $cfgdir, $file);
+
+        } else {
+          croak 'Unable to locate config file from "', $self->src, '", abort';
+        }
+
+      } else {
+        croak 'Unknown config file type "', $self->type, '", abort';
+      }
+    }
+
+    if (-r $src) {
+      open FILE, '<', $src;
+      print 'Config file (', $self->type, '): ', $src, "\n"
+        if $verbose and $self->type and $self->type =~ /$expand_type/;
+
+      @lines = readline 'FILE';
+      close FILE;
+
+    } else {
+      croak 'Unable to read config file "', $src, '", abort';
+    }
+
+    # Record the actual source location
+    $self->actual_src ($src);
+  }
+
+  return @lines;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_expand_variable ($string, $env[, \%recursive]);
+#
+# DESCRIPTION
+#   This internal method expands variables in $string. If $env is true, it
+#   expands environment variables. Otherwise, it expands local variables. If
+#   %recursive is set, it indicates that this method is being called
+#   recursively. In which case, it must not attempt to expand a variable that
+#   exists in the keys of %recursive.
+# ------------------------------------------------------------------------------
+
+sub _expand_variable {
+  my ($self, $string, $env, $recursive) = @_;
+
+  # Pattern for environment/local variable
+  my @patterns = $env
+    ? (qr#\$([A-Z][A-Z0-9_]+)#, qr#\$\{([A-Z][A-Z0-9_]+)\}#)
+    : (qr#%(\w+(?:::[\w\.-]+)*)#, qr#%\{(\w+(?:(?:::|/)[\w\.-]+)*)\}#);
+
+  my $ret = '';
+  my $warning = undef;
+  while ($string) {
+    # Find the first match in $string
+    my ($prematch, $match, $postmatch, $var_label);
+    for my $pattern (@patterns) {
+      next unless $string =~ /$pattern/;
+      if ((not defined $prematch) or length ($`) < length ($prematch)) {
+        $prematch = $`;
+        $match = $&;
+        $var_label = $1;
+        $postmatch = $';
+      }
+    }
+
+    if ($match) {
+      $ret .= $prematch;
+      $string = $postmatch;
+
+      # Get variable value from environment or local configuration
+      my $variable = $env
+                     ? (exists $ENV{$var_label} ? $ENV{$var_label} : undef)
+                     : $self->config->variable ($var_label);
+
+      if ($env and $var_label eq 'HERE' and not defined $variable) {
+        $variable = dirname ($self->actual_src);
+        $variable = File::Spec->rel2abs ($variable) if not &is_url ($variable);
+      }
+
+      # Substitute match with value of variable
+      if (defined $variable) {
+        my $cyclic = 0;
+        if ($recursive) {
+          if (exists $recursive->{$var_label}) {
+            $cyclic = 1;
+
+          } else {
+            $recursive->{$var_label} = 1;
+          }
+
+        } else {
+          $recursive = {$var_label => 1};
+        }
+
+        if ($cyclic) {
+          $warning .= ', ' if $warning;
+          $warning .= $match . ': cyclic dependency, variable not expanded';
+          $ret .= $variable;
+
+        } else {
+          my ($r, $w) = $self->_expand_variable ($variable, $env, $recursive);
+          $ret .= $r;
+          if ($w) {
+            $warning .= ', ' if $warning;
+            $warning .= $w;
+          }
+        }
+
+      } else {
+        $warning .= ', ' if $warning;
+        $warning .= $match . ': variable not expanded';
+        $ret .= $match;
+      }
+
+    } else {
+      $ret .= $string;
+      $string = "";
+    }
+  }
+
+  return ($ret, $warning);
+}
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/CfgLine.pm
===================================================================
--- vendors/FCM/lib/Fcm/CfgLine.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CfgLine.pm	(revision 9621)
@@ -0,0 +1,333 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CfgLine
+#
+# DESCRIPTION
+#   This class is used for grouping the settings in each line of a FCM
+#   configuration file.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CfgLine;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+
+# In-house modules
+use Fcm::Base;
+use Fcm::Config;
+use Fcm::Util;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'bvalue',  # line value, in boolean
+  'comment', # (in)line comment
+  'error',   # error message for incorrect usage while parsing the line
+  'label',   # line label
+  'line',    # content of the line
+  'number',  # line number in source file
+  'parsed',  # has this line been parsed (by the extract/build system)?
+  'prefix',  # optional prefix for line label
+  'slabel',  # label without the optional prefix
+  'src',     # name of source file
+  'value',   # line value
+  'warning', # warning message for deprecated usage
+);
+
+# Useful variables
+our $COMMENT_RULER = '-' x 78;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = Fcm::CfgLine->comment_block (@comment);
+#
+# DESCRIPTION
+#   This method returns a list of Fcm::CfgLine objects representing a comment
+#   block with the comment string @comment.
+# ------------------------------------------------------------------------------
+
+sub comment_block {
+  my @return = (
+    Fcm::CfgLine->new (comment => $COMMENT_RULER),
+    (map {Fcm::CfgLine->new (comment => $_)} @_),
+    Fcm::CfgLine->new (comment => $COMMENT_RULER),
+    Fcm::CfgLine->new (),
+  );
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::CfgLine->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CfgLine class. See above
+#   for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+    $self->{$_} = $args{$_} if exists $args{$_};
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    if (@_) {
+      $self->{$name} = $_[0];
+
+      if ($name eq 'line' or $name eq 'label') {
+        $self->{slabel} = undef;
+
+      } elsif ($name eq 'line' or $name eq 'value') {
+        $self->{bvalue} = undef;
+      }
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name =~ /^(?:comment|error|label|line|prefix|src|value)$/) {
+        # Blank
+        $self->{$name} = '';
+
+      } elsif ($name eq 'slabel') {
+        if ($self->prefix and $self->label_starts_with ($self->prefix)) {
+          $self->{$name} = $self->label_from_field (1);
+
+        } else {
+          $self->{$name} = $self->label;
+        }
+
+      } elsif ($name eq 'bvalue') {
+        if (defined ($self->value)) {
+          $self->{$name} = ($self->value =~ /^(\s*|false|no|off|0*)$/i)
+                           ? 0 : $self->value;
+        }
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @fields = $obj->label_fields ();
+#   @fields = $obj->slabel_fields ();
+#
+# DESCRIPTION
+#   These method returns a list of fields in the (s)label.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_fields';
+  *$sub_name = sub  {
+    return (split (/$Fcm::Config::DELIMITER_PATTERN/, $_[0]->$name));
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->label_from_field ($index);
+#   $string = $obj->slabel_from_field ($index);
+#
+# DESCRIPTION
+#   These method returns the (s)label from field $index onwards.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_from_field';
+  *$sub_name = sub  {
+    my ($self, $index) = @_;
+    my $method = $name . '_fields';
+    my @fields = $self->$method;
+    return join ($Fcm::Config::DELIMITER, @fields[$index .. $#fields]);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->label_starts_with (@fields);
+#   $flag = $obj->slabel_starts_with (@fields);
+#
+# DESCRIPTION
+#   These method returns a true if (s)label starts with the labels in @fields
+#   (ignore case).
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_starts_with';
+  *$sub_name = sub  {
+    my ($self, @fields) = @_;
+    my $return = 1;
+
+    my $method = $name . '_fields';
+    my @all_fields = $self->$method;
+
+    for my $i (0 .. $#fields) {
+      next if lc ($fields[$i]) eq lc ($all_fields[$i] || '');
+      $return = 0;
+      last;
+    }
+
+    return $return;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->label_starts_with_cfg (@fields);
+#   $flag = $obj->slabel_starts_with_cfg (@fields);
+#
+# DESCRIPTION
+#   These method returns a true if (s)label starts with the configuration file
+#   labels in @fields (ignore case).
+# ------------------------------------------------------------------------------
+
+for my $name (qw/label slabel/) {
+  no strict 'refs';
+
+  my $sub_name = $name . '_starts_with_cfg';
+  *$sub_name = sub  {
+    my ($self, @fields) = @_;
+
+    for my $field (@fields) {
+      $field = $self->cfglabel ($field);
+    }
+
+    my $method = $name . '_starts_with';
+    return $self->$method (@fields);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mesg = $obj->format_error ();
+#
+# DESCRIPTION
+#   This method returns a string containing a formatted error message for
+#   anything reported to the current line.
+# ------------------------------------------------------------------------------
+
+sub format_error {
+  my ($self) = @_;
+  my $mesg = '';
+
+  $mesg .= $self->format_warning;
+
+  if ($self->error or not $self->parsed) {
+    $mesg = 'ERROR: ' . $self->src . ': LINE ' . $self->number . ':' . "\n";
+    if ($self->error) {
+      $mesg .= '       ' . $self->error;
+
+    } else {
+      $mesg .= '       ' . $self->label . ': label not recognised.';
+    }
+  }
+
+  return $mesg;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $mesg = $obj->format_warning ();
+#
+# DESCRIPTION
+#   This method returns a string containing a formatted warning message for
+#   any warning reported to the current line.
+# ------------------------------------------------------------------------------
+
+sub format_warning {
+  my ($self) = @_;
+  my $mesg = '';
+
+  if ($self->warning) {
+    $mesg = 'WARNING: ' . $self->src . ': LINE ' . $self->number . ':' . "\n";
+    $mesg .= '         ' . $self->warning;
+  }
+
+  return $mesg;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $line = $obj->print_line ([$space]);
+#
+# DESCRIPTION
+#   This method returns a configuration line using $self->label, $self->value
+#   and $self->comment. The value in $self->line is re-set. If $space is set
+#   and is a positive integer, it sets the spacing between the label and the
+#   value in the line. The default is 1.
+# ------------------------------------------------------------------------------
+
+sub print_line {
+  my ($self, $space) = @_;
+
+  # Set space between label and value, default to 1 character
+  $space = 1 unless $space and $space =~ /^[1-9]\d*$/;
+
+  my $line = '';
+
+  # Add label and value, if label is set
+  if ($self->label) {
+    $line .= $self->label . ' ' x $space;
+    $line .= $self->value if defined $self->value;
+  }
+
+  # Add comment if necessary
+  my $comment = $self->comment;
+  $comment =~ s/^\s*//;
+
+  if ($comment) {
+    $comment = '# ' . $comment if $comment !~ /^#/;
+    $line .= ' ' if $line;
+    $line .= $comment;
+  }
+
+  return $self->line ($line);
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Cm.pm
===================================================================
--- vendors/FCM/lib/Fcm/Cm.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Cm.pm	(revision 9621)
@@ -0,0 +1,2721 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Cm
+#
+# DESCRIPTION
+#   This module contains the FCM code management functionalities and wrappers
+#   to Subversion commands.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Cm;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw(cli cm_check_missing cm_check_unknown cm_switch cm_update);
+
+use Cwd            qw{cwd};
+use Getopt::Long   qw{GetOptions :config bundling};
+use Fcm::CLI::Exception;
+use Fcm::Config;
+use Fcm::CmBranch;
+use Fcm::CmUrl;
+use Fcm::Keyword;
+use Fcm::Util      qw{
+    get_url_of_wc
+    get_url_peg_of_wc
+    get_wct
+    is_url
+    is_wc
+    run_command
+    tidy_url
+};
+use File::Basename qw{basename dirname};
+use File::Path     qw{mkpath rmtree};
+use File::Spec;
+use File::Temp     qw{tempfile};
+use Pod::Usage     qw{pod2usage};
+
+# ------------------------------------------------------------------------------
+
+# CLI message handler
+our $CLI_MESSAGE = \&_cli_message;
+
+# List of CLI messages
+our %CLI_MESSAGE_FOR = (
+    q{}         => "%s",
+    BRANCH_LIST => "%s at %s: %d branch(es) found for %s.\n",
+    CHDIR_WCT   => "%s: working directory changed to top of working copy.\n",
+    CF          => "Conflicts in: %s\n",
+    MERGE       => "Performing merge ...\n",
+    MERGE_CF    => "About to merge in changes from %s compared with %s\n",
+    MERGE_CI    => "The following is added to the commit message file:\n%s",
+    MERGE_DRY   => "This merge will result in the following change:\n",
+    MERGE_REVS  => "Merge(s) available from %s: %s\n",
+    OUT_DIR     => "Output directory: %s\n",
+    PATCH_DONE  => "%s: patch generated.\n",
+    PATCH_REV   => "Patch created for changeset %s\n",
+    SEPARATOR   => q{-} x 80 . "\n",
+    STATUS      => "Status of the target working copy(ies):\n%s",
+);
+
+# CLI abort and error messages
+our %CLI_MESSAGE_FOR_ABORT = (
+    FAIL => "%s: command failed.\n",
+    NULL => "%s: command will result in no change.\n",
+    USER => "%s: abort by user.\n",
+);
+
+# CLI abort and error messages
+our %CLI_MESSAGE_FOR_ERROR = (
+    CHDIR               => "%s: cannot change to directory.\n",
+    CLI                 => "%s",
+    CLI_HELP            => "Type 'fcm help %s' for usage.\n",
+    CLI_MERGE_ARG1      => "Arg 1 must be the source in auto/custom mode.\n",
+    CLI_MERGE_ARG2      => "Arg 2 must be the source in custom mode"
+                           . " if --revision not set.\n",
+    CLI_OPT_ARG         => "--%s: invalid argument [%s].\n",
+    CLI_OPT_WITH_OPT    => "--%s: must be specified with --%s.\n",
+    CLI_USAGE           => "incorrect usage",
+    DIFF_PROJECTS       => "%s (target) and %s (source) are not related.\n",
+    INVALID_BRANCH      => "%s: not a valid URL of a standard FCM branch.\n",
+    INVALID_PROJECT     => "%s: not a valid URL of a standard FCM project.\n",
+    INVALID_TARGET      => "%s: not a valid working copy or URL.\n",
+    INVALID_URL         => "%s: not a valid URL.\n",
+    INVALID_WC          => "%s: not a valid working copy.\n",
+    MERGE_REV_INVALID   => "%s: not a revision in the available merge list.\n",
+    MERGE_SELF          => "%s: cannot be merged to its own working copy: %s.\n",
+    MERGE_UNRELATED     => "%s: target and %s: source not directly related.\n",
+    MERGE_UNSAFE        => "%s: source contains changes outside the target"
+                           . " sub-directory. Please merge with a full tree.\n",
+    MKPATH              => "%s: cannot create directory.\n",
+    NOT_EXIST           => "%s: does not exist.\n",
+    PARENT_NOT_EXIST    => "%s: parent %s no longer exists.\n",
+    RMTREE              => "%s: cannot remove.\n",
+    ST_CONFLICT         => "File(s) in conflicts:\n%s",
+    ST_MISSING          => "File(s) missing:\n%s",
+    ST_OUT_OF_DATE      => "File(s) out of date:\n%s",
+    SWITCH_UNSAFE       => "%s: merge template exists."
+                           . " Please remove before retrying.\n",
+    WC_EXIST            => "%s: working copy already exists.\n",
+    WC_INVALID_BRANCH   => "%s: not a working copy of a standard FCM branch.\n",
+    WC_URL_NOT_EXIST    => "%s: working copy URL does not exists at HEAD.\n",
+);
+
+# List of CLI prompt messages
+our %CLI_MESSAGE_FOR_PROMPT = (
+    CF_OVERWRITE      => qq{%s: existing changes will be overwritten.\n}
+                         . qq{ Do you wish to continue?},
+    CI                => qq{Would you like to commit this change?},
+    CI_BRANCH_SHARED  => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO A %s BRANCH.\n}
+                         . qq{*** Please ensure that you have the}
+                         . qq{ owner's permission.\n\n}
+                         . qq{Would you like to commit this change?},
+    CI_BRANCH_USER    => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO A BRANCH}
+                         . qq{ NOT OWNED BY YOU.\n}
+                         . qq{*** Please ensure that you have the}
+                         . qq{ owner's permission.\n\n}
+                         . qq{Would you like to commit this change?},
+    CI_TRUNK          => qq{\n}
+                         . qq{*** WARNING: YOU ARE COMMITTING TO THE TRUNK.\n}
+                         . qq{*** Please ensure that your change conforms to}
+                         . qq{ your project's working practices.\n\n}
+                         . qq{Would you like to commit this change?},
+    CONTINUE          => qq{Are you sure you want to continue?},
+    MERGE             => qq{Would you like to go ahead with the merge?},
+    MERGE_REV         => qq{Please enter the revision you wish to merge from},
+    MKPATCH_OVERWRITE => qq{%s: output location exists. OK to overwrite?},
+    RUN_SVN_COMMAND   => qq{Would you like to run "svn %s"?},
+);
+
+# List of CLI warning messages
+our %CLI_MESSAGE_FOR_WARNING = (
+    BRANCH_SUBDIR   => "%s: is a sub-directory of a branch in a FCM project.\n",
+    CF_BINARY       => "%s: ignoring binary file, please resolve manually.\n",
+    INVALID_BRANCH  => $CLI_MESSAGE_FOR_ERROR{INVALID_BRANCH},
+    ST_IN_TRAC_DIFF => "%s: local changes cannot be displayed in Trac.\n"
+);
+
+# CLI prompt handler and title prefix
+our $CLI_PROMPT = \&_cli_prompt;
+our $CLI_PROMPT_PREFIX = q{fcm };
+
+# List of exception handlers [$class, CODE->($function, $e)]
+our @CLI_EXCEPTION_HANDLERS = (
+    ['Fcm::CLI::Exception', \&_cli_e_handler_of_cli_exception],
+    ['Fcm::Cm::Exception' , \&_cli_e_handler_of_cm_exception],
+    ['Fcm::Cm::Abort'     , \&_cli_e_handler_of_cm_abort],
+);
+
+# Event handlers
+our %CLI_HANDLER_OF = (
+    'WC_STATUS'      => \&_cli_handler_of_wc_status,
+    'WC_STATUS_PATH' => \&_cli_handler_of_wc_status_path,
+);
+
+# Handlers of sub-commands
+our %CLI_IMPL_OF = (
+    'add'       => \&_cli_command_add,
+    'branch'    => \&cm_branch,
+    'commit'    => \&cm_commit,
+    'conflicts' => \&cm_conflicts,
+    'checkout'  => \&_cli_command_checkout,
+    'delete'    => \&_cli_command_delete,
+    'diff'      => \&cm_diff,
+    'merge'     => \&cm_merge,
+    'mkpatch'   => \&cm_mkpatch,
+    'switch'    => \&_cli_command_switch,
+    'update'    => \&_cli_command_update,
+);
+
+# List of overridden subcommands that need to display "svn help"
+our %CLI_MORE_HELP_FOR = map {($_, 1)} qw{add diff delete switch update};
+
+# The preferred name of subcommand aliases
+our %CLI_PREFERRED_NAME_OF = (
+    'ann'      => 'blame',
+    'annotate' => 'blame',
+    'br'       => 'branch',
+    'ci'       => 'commit',
+    'cf'       => 'conflicts',
+    'co'       => 'checkout',
+    'cp'       => 'copy',
+    'del'      => 'delete',
+    'di'       => 'diff',
+    'ls'       => 'list',
+    'mv'       => 'move',
+    'pd'       => 'propdel',
+    'pdel'     => 'propdel',
+    'pe'       => 'propedit',
+    'pedit'    => 'propedit',
+    'pg'       => 'propget',
+    'pget'     => 'propget',
+    'pl'       => 'proplist',
+    'plist'    => 'proplist',
+    'praise'   => 'blame',
+    'ps'       => 'propset',
+    'pset'     => 'propset',
+    'remove'   => 'delete',
+    'ren'      => 'move',
+    'rename'   => 'move',
+    'rm'       => 'delete',
+    'sw'       => 'switch',
+    'up'       => 'update',
+);
+
+# List of subcommands that accept URL inputs
+our %CLI_SUBCOMMAND_URL = map {($_, 1)} qw{
+    blame
+    branch
+    cat
+    checkout
+    copy
+    delete
+    diff
+    export
+    import
+    info
+    list
+    lock
+    log
+    merge
+    mkdir
+    mkpatch
+    move
+    propdel
+    propedit
+    propget
+    proplist
+    propset
+    switch
+    unlock
+};
+
+# List of subcommands that accept revision inputs
+our %CLI_SUBCOMMAND_REV = map {($_, 1)} qw{
+    blame
+    branch
+    cat
+    checkout
+    copy
+    diff
+    export
+    info
+    list
+    log
+    merge
+    mkpatch
+    move
+    propdel
+    propedit
+    propget
+    proplist
+    propset
+    switch
+};
+
+# Common patterns
+our %PATTERN_OF = (
+    # A CLI option
+    CLI_OPT => qr{
+        \A            (?# beginning)
+        (--\w[\w-]*=) (?# capture 1, a long option label)
+        (.*)          (?# capture 2, the value of the option)
+        \z            (?# end)
+    }xms,
+    # A CLI revision option
+    CLI_OPT_REV => qr{
+        \A                      (?# beginning)
+        (--revision(?:=|\z)|-r) (?# capture 1, --revision, --revision= or -r)
+        (.*)                    (?# capture 2, trailing value)
+        \z                      (?# end)
+    }xms,
+    # A CLI revision option range
+    CLI_OPT_REV_RANGE => qr{
+        \A                  (?# beginning)
+        (                   (?# capture 1, begin)
+            (?:\{[^\}]+\}+) (?# a date in curly braces)
+            |               (?# or)
+            [^:]+           (?# anything but a colon)
+        )                   (?# capture 1, end)
+        (?::(.*))?          (?# colon, and capture 2 til the end)
+        \z                  (?# end)
+    }xms,
+    # A FCM branch path look-alike, should be configurable in the future
+    FCM_BRANCH_PATH => qr{
+        \A                            (?# beginning)
+        /*                            (?# some slashes)
+        (?:                           (?# group 1, begin)
+            (?:trunk/*(?:@\d+)?\z)    (?# trunk at a revision)
+            |                         (?# or)
+            (?:trunk|branches|tags)/+ (?# trunk, branch or tags)
+        )                             (?# group 1, end)
+    }xms,
+    # Last line of output from "svn status -u"
+    ST_AGAINST_REV => qr{
+        \A                           (?# beginning)
+        Status\sagainst\srevision:.* (?# output of svn status -u)
+        \z                           (?# end)
+    }xms,
+    # Extract path from "svn status"
+    ST_PATH => qr{
+        \A   (?# beginning)
+        .{6} (?# 6 columns)
+        \s+  (?# spaces)
+        (.+) (?# capture 1, target path)
+        \z   (?# end)
+    }xms,
+    # A legitimate "svn" revision
+    SVN_REV => qr{
+        \A                                      (?# beginning)
+        (?:\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}) (?# digit, reserved words, date)
+        \z                                      (?# end)
+    }ixms,
+);
+
+# Status matchers
+our %ST_MATCHER_FOR = (
+    MISSING     => sub {substr($_[0], 0, 1) eq '!'},
+    MODIFIED    => sub {substr($_[0], 0, 6) =~ qr{\S}xms},
+    OUT_OF_DATE => sub {substr($_[0], 7, 1) eq '*'},
+    UNKNOWN     => sub {substr($_[0], 0, 1) eq '?'},
+);
+
+# ------------------------------------------------------------------------------
+# Entry function for the FCM code management CLI. Calls the relevant FCM code
+# management function or SVN command based on $function.
+sub cli {
+    my ($function, @args) = @_;
+    if (exists($CLI_PREFERRED_NAME_OF{$function})) {
+        $function = $CLI_PREFERRED_NAME_OF{$function};
+    }
+    if (grep {$_ eq '-h' || $_ eq '--help'} @args) {
+        return _cli_help($function, 'NOEXIT');
+    }
+    if (exists($CLI_SUBCOMMAND_URL{$function})) {
+        _cli_keyword_expand_url(\@args);
+    }
+    if (exists($CLI_SUBCOMMAND_REV{$function})) {
+        _cli_keyword_expand_rev(\@args);
+    }
+    if (exists($CLI_IMPL_OF{$function})) {
+        eval {
+            local(@ARGV) = @args;
+            return $CLI_IMPL_OF{$function}->(@args);
+        };
+        if ($@) {
+            my $e = $@;
+            for (@CLI_EXCEPTION_HANDLERS) {
+                my ($class, $handler) = @{$_};
+                if ($class->caught($e)) {
+                    return $handler->($function, $e);
+                }
+            }
+            die($e);
+        }
+    }
+    else {
+        return _svn($function, @args);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_branch ();
+#
+# DESCRIPTION
+#   This is a FCM command to check information, create or delete a branch in
+#   a Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub cm_branch {
+  # Process command line options
+  # ----------------------------------------------------------------------------
+  my (
+    $info,
+    $delete,
+    $create,
+    $list,
+    $branch_of_branch,
+    $name,
+    $non_interactive,
+    $password,
+    $rev,
+    $rev_flag,
+    $show_all,
+    $show_children,
+    $show_other,
+    $show_siblings,
+    $svn_non_interactive,
+    @tickets,
+    $type,
+    @userlist,
+    $verbose,
+  );
+  my $rc = GetOptions(
+    'info|i'              => \$info,
+    'delete|d'            => \$delete,
+    'create|c'            => \$create,
+    'list|l'              => \$list,
+    'branch-of-branch'    => \$branch_of_branch,
+    'name|n=s'            => \$name,
+    'non-interactive'     => \$non_interactive,
+    'password=s'          => \$password,
+    'revision|r=s'        => \$rev,
+    'rev-flag=s'          => \$rev_flag,
+    'show-all|a'          => \$show_all,
+    'show-children'       => \$show_children,
+    'show-other'          => \$show_other,
+    'show-siblings'       => \$show_siblings,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'ticket|k=s'          => \@tickets,
+    'type|t=s'            => \$type,
+    'user|u=s'            => \@userlist,
+    'verbose|v'           => \$verbose,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  my $num_options = 0;
+  $num_options++ if defined $info;
+  $num_options++ if defined $delete;
+  $num_options++ if defined $create;
+  $num_options++ if defined $list;
+  if ($num_options > 1) {
+    _cli_err();
+  }
+
+  # Get URL of repository or branch
+  # ----------------------------------------------------------------------------
+  my $url;
+  if ($ARGV[0]) {
+    $url = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if (not $url->is_url) {
+      # An argument is specified and is not a URL
+      # Assume that it is a path with a working copy
+      if (&is_wc ($ARGV[0])) {
+        $url = Fcm::CmUrl->new (URL => &get_url_of_wc ($ARGV[0]));
+
+      } else {
+        return _cm_err(Fcm::Cm::Exception->INVALID_WC, $ARGV[0]);
+      }
+    }
+
+  } else {
+    # An argument is not specified
+    # Assume that the current directory is a working copy
+    if (&is_wc ()) {
+      $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+    } else {
+      return _cm_err(Fcm::Cm::Exception->INVALID_TARGET, '.');
+    }
+  }
+
+  # Ensure $url->url_peg is a URL of a standard FCM project
+  if (!$url->project_url()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_PROJECT, $url->url_peg());
+  }
+
+  if ($create) {
+    # The --create option is specified, create a branch
+    # --------------------------------------------------------------------------
+
+    # Check branch type flags
+    if ($type) {
+      $type = uc ($type);
+
+      if ($type =~ /^(USER|SHARE)$/) {
+        $type = 'DEV' . $Fcm::Config::DELIMITER . $1;
+
+      } elsif ($type =~ /^(CONFIG|REL)$/) {
+        $type = 'PKG' . $Fcm::Config::DELIMITER . $1;
+
+      } elsif ($type =~ /^(DEV|TEST|PKG)$/) {
+        $type = $1 . $Fcm::Config::DELIMITER . 'USER';
+
+      } elsif ($type !~ /^(?:DEV|TEST|PKG)$Fcm::Config::DELIMITER(?:USER|SHARE)$/
+               and $type !~ /^PKG$Fcm::Config::DELIMITER(?:CONFIG|REL)/) {
+        _cli_err('CLI_OPT_ARG', 'type', $type);
+      }
+
+    } else {
+      $type = 'DEV' . $Fcm::Config::DELIMITER . 'USER';
+    }
+
+    # Check branch name
+    if (!$name) {
+      _cli_err('CLI_OPT_WITH_OPT', 'name', 'create');
+    }
+
+    if ($name !~ qr{\A[\w.-]+\z}xms) {
+      _cli_err('CLI_OPT_ARG', 'name', $name);
+    }
+
+    # Check revision flag is valid
+    if ($rev_flag) {
+      $rev_flag = uc ($rev_flag);
+      if ($rev_flag !~ qr{\A (?:NORMAL|NUMBER|NONE) \z}xms) {
+        _cli_err('CLI_OPT_ARG', 'rev-flag', $rev_flag);
+      }
+
+    } else {
+      $rev_flag = 'NORMAL';
+    }
+
+    # Handle multiple tickets
+    @tickets = split (
+      /$Fcm::Config::DELIMITER_LIST/,
+      join ($Fcm::Config::DELIMITER_LIST, @tickets)
+    );
+    s/^#// for (@tickets);
+    @tickets = sort {$a <=> $b} @tickets;
+
+    # Determine whether to create a branch of a branch
+    $url->branch ('trunk') unless $branch_of_branch;
+
+    # Create the branch
+    my $branch = Fcm::CmBranch->new;
+    $branch->create (
+      SRC                 => $url,
+      TYPE                => $type,
+      NAME                => $name,
+      PASSWORD            => $password,
+      REV_FLAG            => $rev_flag,
+      TICKET              => \@tickets,
+      REV                 => $rev,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    );
+
+  } elsif ($list) {
+    # The option --list is specified
+    # List branches owned by current or specified users
+    # --------------------------------------------------------------------------
+    # Get URL of the project "branches/" sub-directory
+    $url->subdir ('');
+    $url->branch ('');
+
+    my @branches = $url->branch_list($rev);
+    if (!$show_all) {
+      @userlist = split(qr{:}xms, join(q{:}, @userlist));
+      if (!@userlist) {
+        @userlist = (Fcm::Config->instance()->user_id());
+      }
+      my %filter = map {($_, 1)} @userlist;
+      @branches = grep {
+        $filter{Fcm::CmBranch->new(URL => $_)->branch_owner()}
+      } @branches
+    }
+
+    # Output, number of branches found
+    $CLI_MESSAGE->(
+      'BRANCH_LIST',
+      $url->project_url_peg(),
+      $rev ? "r$rev" : 'HEAD',
+      scalar(@branches),
+      ($show_all ? '[--show-all]' : join(q{, }, sort(@userlist))),
+    );
+
+    if (@branches) {
+      # Output the URL of each branch
+      if (not $verbose) {
+        my $project = $url->project_url;
+        @branches = map {Fcm::Keyword::unexpand($_)} @branches;
+      }
+      @branches = map {$_ . "\n"} sort @branches;
+      $CLI_MESSAGE->(q{}, join(q{}, @branches));
+
+    } else {
+      # No branch found, exit with an error code
+      return;
+    }
+
+  } else {
+    # The option --info or --delete is specified
+    # Report branch information (and/or delete a branch)
+    # --------------------------------------------------------------------------
+    # Set verbose level
+    Fcm::Config->instance()->verbose ($verbose ? 1 : 0);
+
+    # Set up the branch, report any error
+    my $branch = Fcm::CmBranch->new (URL => $url->url_peg);
+    if (!$branch->branch()) {
+      return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $branch->url_peg());
+    }
+    if (!$branch->url_exists()) {
+      return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $branch->url_peg());
+    }
+
+    # Remove the sub-directory part of the URL
+    $branch->subdir ('');
+
+    # Report branch info
+    $branch->display_info (
+      SHOW_CHILDREN => ($show_all || $show_children),
+      SHOW_OTHER    => ($show_all || $show_other   ),
+      SHOW_SIBLINGS => ($show_all || $show_siblings),
+    );
+
+    # Delete branch if --delete is specified
+    $branch->del (
+      PASSWORD            => $password,
+      NON_INTERACTIVE     => $non_interactive,
+      SVN_NON_INTERACTIVE => $svn_non_interactive,
+    ) if $delete;
+  }
+
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_commit ();
+#
+# DESCRIPTION
+#   This is a FCM wrapper to the "svn commit" command.
+# ------------------------------------------------------------------------------
+
+sub cm_commit {
+  my ($dry_run, $svn_non_interactive, $password);
+  my $rc = GetOptions(
+    'dry-run'             => \$dry_run,
+    'svn-non-interactive' => \$svn_non_interactive,
+    'password=s'          => \$password,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  # The remaining argument is the path to a working copy
+  my ($path) = @ARGV;
+
+  if ($path) {
+    if (!-e $path) {
+      return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $path);
+    }
+
+  } else {
+    # No argument specified, use current working directory
+    $path = cwd ();
+  }
+
+  # Make sure we are in a working copy
+  if (!is_wc($path)) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path);
+  }
+
+  # Make sure we are at the top level of the working copy
+  # (otherwise we might miss any template commit message)
+  my $dir = &get_wct ($path);
+
+  if ($dir ne cwd ()) {
+    chdir($dir) || return _cm_err(Fcm::Cm::Exception->CHDIR, $dir);
+    $CLI_MESSAGE->('CHDIR_WCT', $dir);
+  }
+
+  # Get update status of working copy
+  # Check working copy files are not in conflict, missing, or out of date
+  my @status = _svn_status_get([], 1);
+  unless (defined $dry_run) {
+    my (@conflict, @missing, @outdate);
+
+    for (@status) {
+      if (/^C/) {
+        push @conflict, $_;
+        next;
+      }
+
+      if (/^!/) {
+        push @missing, $_;
+        next;
+      }
+
+      if (/^.{7}\*/) {
+        push @outdate, $_;
+        next;
+      }
+
+      # Check that all files which have been added have the svn:executable
+      # property set correctly (in case the developer adds a script before they
+      # remember to set the execute bit)
+      next unless /^A.{7} *\d+ +(.*)/;
+      my $file = $1;
+
+      next unless -f $file;
+      my ($command, @arguments)
+        = (-x $file && !-l $file) ? ('propset', '*') : ('propdel');
+      run_command(['svn', $command, qw{-q svn:executable}, @arguments, $file]);
+    }
+
+    # Abort commit if files are in conflict, missing, or out of date
+    if (@conflict or @missing or @outdate) {
+      for (
+        ['ST_CONFLICT'   , \@conflict],
+        ['ST_MISSING'    , \@missing ],
+        ['ST_OUT_OF_DATE', \@outdate ],
+      ) {
+        my ($key, $array_ref) = @{$_};
+        if (@{$array_ref}) {
+          $CLI_MESSAGE->($key, join(q{}, @{$array_ref}));
+        }
+      }
+      return _cm_abort(Fcm::Cm::Abort->FAIL);
+    }
+  }
+
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+
+  # Execute "svn status" for a list of changed items
+  @status = grep !/^\?/, _svn_status_get();
+
+  # Abort if there is no change in the working copy
+  if (!@status) {
+    return _cm_abort(Fcm::Cm::Abort->NULL);
+  }
+
+  # Get associated URL of current working copy
+  my $url = Fcm::CmUrl->new (URL => &get_url_of_wc ());
+
+  # Include URL, or project, branch and sub-directory info in @status
+  unshift @status, "\n";
+
+  if ($url->project and $url->branch) {
+    unshift @status, (
+      '[Project: ' . $url->project                           . ']' . "\n",
+      '[Branch : ' . $url->branch                            . ']' . "\n",
+      '[Sub-dir: ' . ($url->subdir ? $url->subdir : '<top>') . ']' . "\n",
+    );
+
+  } else {
+    unshift @status, '[URL: ' . $url->url . ']' . "\n";
+  }
+
+  # Use a temporary file to store the final commit log message
+  $ci_mesg->ignore_mesg (\@status);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1);
+
+  # Check with the user to see if he/she wants to go ahead
+  my $reply = 'n';
+  if (!defined($dry_run)) {
+    # Add extra warning for trunk commit
+    my @prompt_args;
+    my $user = Fcm::Config->instance()->user_id();
+
+    if ($url->is_trunk()) {
+      @prompt_args = ('CI_TRUNK');
+    }
+    elsif ($user && $url->is_branch() && $url->branch_owner() ne $user) {
+      if (exists $Fcm::CmUrl::owner_keywords{$url->branch_owner}) {
+        @prompt_args = (
+          'CI_BRANCH_SHARED',
+          uc($Fcm::CmUrl::owner_keywords{$url->branch_owner()}),
+        );
+      }
+      else {
+        @prompt_args = ('CI_BRANCH_USER');
+      }
+    }
+    else {
+      @prompt_args = ('CI');
+    }
+    $reply = $CLI_PROMPT->('commit', @prompt_args);
+  }
+
+  if ($reply eq 'y') {
+    # Commit the change if user replies "y" for "yes"
+    my @command = (
+      qw/svn commit -F/, $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+    );
+    my $rc;
+    &run_command (\@command, RC => \$rc, ERROR => 'warn');
+
+    if ($rc) {
+      # Commit failed
+      # Write temporary commit log content to commit log message file
+      $ci_mesg->write_file;
+
+      # Fail the command
+      return _cm_abort(Fcm::Cm::Abort->FAIL);
+    }
+
+    # Remove commit message file
+    unlink $ci_mesg->file;
+
+    # Update the working copy
+    $CLI_MESSAGE->(q{}, join(q{}, _svn_update()));
+
+  } else {
+    $ci_mesg->write_file;
+    if (!$dry_run) {
+      return _cm_abort();
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_conflicts ();
+#
+# DESCRIPTION
+#   This is a FCM command for resolving conflicts within working copy using a
+#   graphical merge tool.
+# ------------------------------------------------------------------------------
+
+sub cm_conflicts {
+  # Path to the working copy
+  my $path = $ARGV[0];
+  $path    = cwd () if not $path;
+
+  # Check for any files with conflicts
+  my @status = grep /^C.{4} *(.*)/, &run_command (
+    [qw/svn st/, ($path eq cwd () ? () : $path)], METHOD => 'qx',
+  );
+  my @files  = map {m/^C.{4} *(.*)/; $1} @status;
+
+  # Save current working directory
+  my $topdir = cwd ();
+
+  # Set up environment for graphical merge
+  # Use environment variable if set, otherwise use default setting
+  local(%ENV) = %ENV;
+  $ENV{FCM_GRAPHIC_MERGE}
+    ||= Fcm::Config->instance()->setting (qw/TOOL GRAPHIC_MERGE/);
+
+  FILE:
+  for my $file (@files) {
+    # Print name of file in conflicts
+    $CLI_MESSAGE->('CF', $file);
+
+    # Determine directory and base name of file in conflicts
+    my $base = basename $file;
+    my $dir  = dirname $file;
+
+    # Change to container directory of file in conflicts
+    chdir(File::Spec->catfile($topdir, $dir))
+      || return _cm_err(Fcm::Cm::Exception->CHDIR, $dir);
+
+    # Use "svn info" to determine conflict marker files
+    my @info = &run_command ([qw/svn info/, $base], METHOD => 'qx');
+
+    # Ignore if $base is a binary file
+    if (-B $base) {
+      $CLI_MESSAGE->('CF_BINARY', $base);
+      next FILE;
+    }
+
+    # Get conflicts markers files
+    my ($older, $mine, $yours);
+
+    for (@info) {
+      $older = $1 if (/^Conflict Previous Base File: (.*)/);
+      $mine  = $1 if (/^Conflict Previous Working File: (.*)/);
+      $yours = $1 if (/^Conflict Current Base File: (.*)/);
+    }
+
+    if (-f $base and (stat $base)[9] > (stat $mine)[9] + 1) {
+      # If $base is newer (by more than a second), it may contain saved changes
+      if ($CLI_PROMPT->('conflicts', 'CF_OVERWRITE', $base) ne 'y') {
+        next FILE;
+      }
+    }
+
+    # Launch graphic merge tool
+    my $rc;
+    my $command = [qw/fcm_graphic_merge/, $base, $mine, $older, $yours];
+    # $rc == 0: all conflicts resovled
+    # $rc == 1: some conflicts not resolved
+    # $rc == 2: trouble
+    eval {
+      run_command($command, RC => \$rc);
+    };
+    if ($@) {
+      if (!defined($rc) || $rc > 1) {
+        die($@);
+      }
+    }
+    next FILE if $rc;
+
+    # Prompt user to run "svn resolved" on the file
+    if ($CLI_PROMPT->('conflicts', 'RUN_SVN_COMMAND', 'resolved') eq 'y') {
+      run_command([qw{svn resolved}, $base]);
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_diff ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn diff". It adds two extra functionalities. The
+#   first one allows the command to show differences relative to the base of
+#   the branch. The second one allows differences to be displayed via a
+#   graphical tool.
+# ------------------------------------------------------------------------------
+
+sub cm_diff {
+  # Set up environment for graphical diff
+  # Use environment variable if set, otherwise use default setting
+  local(%ENV) = %ENV;
+  $ENV{FCM_GRAPHIC_DIFF}
+    ||= Fcm::Config->instance()->setting(qw/TOOL GRAPHIC_DIFF/);
+
+  # Check for the --branch options
+  # ----------------------------------------------------------------------------
+  my $branch = grep {$_ eq '-b' or $_ eq '--branch'} @ARGV;
+
+  if (not $branch) {
+    # The --branch option not specified, just call "svn diff"
+    # Convert the --graphical to qw/--diff-cmd fcm_graphical_diff/
+    # Convert the --summarise to --summarize
+    @ARGV = map {
+      my @return;
+      if ($_ eq '-g' or $_ eq '--graphical') {
+        @return = (qw/--diff-cmd fcm_graphic_diff/)
+
+      } elsif ($_ eq '--summarise') {
+        @return = ('--summarize');
+
+      } else {
+        @return = ($_);
+      }
+      @return;
+    } @ARGV;
+
+    # Execute the command
+    return _svn('diff', @ARGV);
+  }
+
+  # The --branch option is specified
+  # ----------------------------------------------------------------------------
+
+  # Determine whether the --graphical option is specified,
+  # if so set the appropriate command
+  # ----------------------------------------------------------------------------
+  my ($diff_cmd, $extensions, $graphical, $summarise, $trac, $wiki);
+  my $rc = GetOptions (
+    'b|branch'            => \$branch,
+    'diff-cmd=s'          => \$diff_cmd,
+    'x|extensions=s'      => \$extensions,
+    'g|graphical'         => \$graphical,
+    'summarise|summarize' => \$summarise,
+    't|trac'              => \$trac,
+    'wiki'                => \$wiki,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  my @diff_cmd = ();
+
+  if ($graphical) {
+    @diff_cmd = (qw/--diff-cmd fcm_graphic_diff/);
+
+  } elsif ($diff_cmd) {
+    @diff_cmd = ('--diff-cmd', $diff_cmd);
+
+    push @diff_cmd, '--extensions', split (/\s+/, $extensions) if $extensions;
+  }
+
+  # The remaining argument should either be a URL or a PATH
+  my ($url_arg, $path_arg);
+
+  if (@ARGV) {
+    my $arg = Fcm::CmUrl->new (URL => $ARGV[0]);
+
+    if ($arg->is_url) {
+      $url_arg = $ARGV[0];
+
+    } else {
+      $path_arg = $ARGV[0];
+    }
+  }
+
+  # Get repository and branch information
+  # ----------------------------------------------------------------------------
+  my ($url, $path);
+  if (defined $url_arg) {
+    # If a URL is specified, get repository and branch information from it
+    $url = Fcm::CmBranch->new (URL => $url_arg);
+
+  } else {
+    # Get repository and branch information from the specified path or the
+    # current directory if it is a working copy
+    $path = $path_arg ? $path_arg : cwd ();
+    if (!is_wc($path)) {
+      return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path);
+    }
+
+    $url  = Fcm::CmBranch->new (URL => &get_url_peg_of_wc ($path));
+  }
+
+  # Check that URL is a standard FCM branch
+  if (!$url->is_branch()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $url->url_peg());
+  }
+
+  # Save and remove sub-directory part of the URL
+  my $subdir = $url->subdir ();
+  $url->subdir ('');
+
+  # Check that $url exists
+  if (!$url->url_exists()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_URL, $url->url_peg());
+  }
+
+  # Compare current branch with its parent
+  # ----------------------------------------------------------------------------
+  my $parent = Fcm::CmBranch->new (URL => $url->parent->url);
+  $parent->pegrev ($url->pegrev) if $url->pegrev;
+
+  if (!$parent->url_exists()) {
+    return _cm_err(
+      Fcm::Cm::Exception->PARENT_NOT_EXIST, $url->url_peg(), $parent->url(),
+    );
+  }
+
+  my $base = $parent->base_of_merge_from ($url);
+
+  # Ensure the correct diff (syntax) is displayed
+  # ----------------------------------------------------------------------------
+  # Reinstate the sub-tree part into the URL
+  $url->subdir ($subdir);
+  $base->subdir ($subdir);
+
+  # Ensure the branch URL has a peg revision
+  $url->pegrev ($url->svninfo (FLAG => 'Last Changed Rev')) if not $url->pegrev;
+
+  if ($trac or $wiki) {
+    # Trac/wiki
+    # --------------------------------------------------------------------------
+    if (!$url_arg && _svn_status_get([$path_arg ? $path_arg : q{.}])) {
+      $CLI_MESSAGE->('ST_IN_TRAC_DIFF', ($path_arg ? $path_arg : q{.}));
+    }
+
+    # Trac wiki syntax
+    my $wiki_syntax = 'diff:' . $base->path_peg . '//' . $url->path_peg;
+
+    if ($wiki) {
+      # Print Trac wiki syntax only
+      $CLI_MESSAGE->(q{}, "$wiki_syntax\n");
+
+    } else { # if $trac
+      # Use Trac to view "diff"
+      my $browser = Fcm::Config->instance()->setting(qw/WEB_BROWSER/);
+      $browser ||= 'firefox';
+
+      my $trac_url = Fcm::Keyword::get_browser_url($url->project_url());
+      $trac_url =~ s{/intertrac/.*$}{/intertrac/$wiki_syntax}xms;
+
+      &run_command ([$browser, $trac_url], METHOD => 'exec', PRINT => 1);
+    }
+
+  } else {
+    # Execute the "diff" command
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn diff/, @diff_cmd,
+      ($summarise ? ('--summarize') : ()),
+      '--old', $base->url_peg,
+      '--new', ($url_arg ? $url->url_peg : ($path_arg ? $path_arg : '.')),
+    );
+    &run_command (\@command, PRINT => 1);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_merge ();
+#
+# DESCRIPTION
+#   This is a wrapper to "svn merge".
+# ------------------------------------------------------------------------------
+
+sub cm_merge {
+  # Options
+  # ----------------------------------------------------------------------------
+  my ($custom, $dry_run, $non_interactive, $reverse, $rev, $verbose);
+  my $rc = GetOptions(
+    'custom'          => \$custom,
+    'dry-run'         => \$dry_run,
+    'non-interactive' => \$non_interactive,
+    'reverse'         => \$reverse,
+    'revision|r=s'    => \$rev,
+    'verbose|v'       => \$verbose,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  # Find out the URL of the working copy
+  # ----------------------------------------------------------------------------
+  my ($target, $wct);
+  if (&is_wc ()) {
+    $wct = &get_wct ();
+
+    if ($wct ne cwd ()) {
+      chdir($wct) || return _cm_err(Fcm::Cm::Exception->CHDIR, $wct);
+      $CLI_MESSAGE->('CHDIR_WCT', $wct);
+    }
+
+    $target = Fcm::CmBranch->new (URL => &get_url_of_wc ($wct));
+
+  } else {
+    return _cm_err(Fcm::Cm::Exception->INVALID_WC, '.');
+  }
+
+  if (!$target->url_exists()) {
+    return _cm_err(Fcm::Cm::Exception->WC_URL_NOT_EXIST, '.');
+  }
+
+  # The target must be at the top of a branch
+  # $subdir will be used later to determine whether the merge is allowed or not
+  my $subdir = $target->subdir;
+  $target->subdir ('') if $subdir;
+
+  # Check for any local modifications
+  # ----------------------------------------------------------------------------
+  if (!$dry_run && !$non_interactive) {
+    _svn_status_checker('merge', 'MODIFIED', $CLI_HANDLER_OF{WC_STATUS})->();
+  }
+
+  # Determine the SOURCE URL
+  # ----------------------------------------------------------------------------
+  my $source;
+
+  if ($reverse) {
+    # Reverse merge, the SOURCE is the the working copy URL
+    $source = Fcm::CmBranch->new (URL => $target->url);
+
+  } else {
+    # Automatic/custom merge, argument 1 is the SOURCE of the merge
+    my $source_url = shift (@ARGV);
+    if (!$source_url) {
+      _cli_err('CLI_MERGE_ARG1');
+    }
+
+    $source = _cm_get_source($source_url, $target);
+  }
+
+  # Parse the revision option
+  # ----------------------------------------------------------------------------
+  if ($reverse && !$rev) {
+    _cli_err('CLI_OPT_WITH_OPT', 'revision', 'reverse');
+  }
+  my @revs = (($reverse || $custom) && $rev ? split(qr{:}xms, $rev) : ());
+
+  # Determine the merge delta and the commit log message
+  # ----------------------------------------------------------------------------
+  my (@delta, $mesg);
+  my $separator = '-' x 80 . "\n";
+
+  if ($reverse) {
+    # Reverse merge
+    # --------------------------------------------------------------------------
+    if (@revs == 1) {
+      $revs[1] = ($revs[0] - 1);
+
+    } else {
+      @revs = sort {$b <=> $a} @revs;
+    }
+
+    $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+      unless $source->pegrev;
+    $source->subdir ($subdir);
+
+    # "Delta" of the "svn merge" command
+    @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+    # Template message
+    $mesg = 'Reversed r' . $revs[0] .
+            (($revs[1] < $revs[0] - 1) ? ':' . $revs[1] : '') . ' of ' .
+            $source->path . "\n";
+
+  } elsif ($custom) {
+    # Custom merge
+    # --------------------------------------------------------------------------
+    if (@revs) {
+      # Revision specified
+      # ------------------------------------------------------------------------
+      # Only one revision N specified, use (N - 1):N as the delta
+      unshift @revs, ($revs[0] - 1) if @revs == 1;
+
+      $source->pegrev ($source->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source->subdir ($subdir);
+      $target->subdir ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ('-r' . $revs[0] . ':' . $revs[1], $source->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': r' . $revs[1] .
+              ' cf. r' . $revs[0] . ' of ' . $source->path_peg . "\n";
+
+    } else {
+      # Revision not specified
+      # ------------------------------------------------------------------------
+      # Get second source URL
+      my $source2_url = shift (@ARGV);
+      if (!$source2_url) {
+        _cli_err('CLI_MERGE_ARG2');
+      }
+
+      my $source2 = _cm_get_source($source2_url, $target);
+
+      $source->pegrev  ($source->svninfo  (FLAG => 'Last Changed Rev'))
+        unless $source->pegrev;
+      $source2->pegrev ($source2->svninfo (FLAG => 'Last Changed Rev'))
+        unless $source2->pegrev;
+      $source->subdir  ($subdir);
+      $source2->subdir ($subdir);
+      $target->subdir  ($subdir);
+
+      # "Delta" of the "svn merge" command
+      @delta = ($source->url_peg, $source2->url_peg);
+
+      # Template message
+      $mesg = 'Custom merge into ' . $target->path . ': ' . $source->path_peg .
+              ' cf. ' . $source2->path_peg . "\n";
+    }
+
+  } else {
+    # Automatic merge
+    # --------------------------------------------------------------------------
+    # Check to ensure source branch is not the same as the target branch
+    if (!$target->branch()) {
+      return _cm_err(Fcm::Cm::Exception->WC_INVALID_BRANCH, $wct);
+    }
+    if ($source->branch() eq $target->branch()) {
+      return _cm_err(Fcm::Cm::Exception->MERGE_SELF, $target->url_peg(), $wct);
+    }
+
+    # Only allow the merge if the source and target are "directly related"
+    # --------------------------------------------------------------------------
+    my $anc = $target->ancestor ($source);
+    return _cm_err(
+      Fcm::Cm::Exception->MERGE_UNRELATED, $target->url_peg(), $source->url_peg
+    ) unless
+      ($anc->url eq $target->url and $anc->url_peg eq $source->parent->url_peg)
+      or
+      ($anc->url eq $source->url and $anc->url_peg eq $target->parent->url_peg)
+      or
+      ($anc->url eq $source->parent->url and $anc->url eq $target->parent->url);
+
+    # Check for available merges from the source
+    # --------------------------------------------------------------------------
+    my @revs = $target->avail_merge_from ($source, 1);
+
+    if (@revs) {
+      if ($verbose) {
+        # Verbose mode, print log messages of available merges
+        $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), q{});
+        for (@revs) {
+          $CLI_MESSAGE->('SEPARATOR');
+          $CLI_MESSAGE->(q{}, $source->display_svnlog($_));
+        }
+        $CLI_MESSAGE->('SEPARATOR');
+      }
+      else {
+        # Normal mode, list revisions of available merges
+        $CLI_MESSAGE->('MERGE_REVS', $source->path_peg(), join(q{ }, @revs));
+      }
+
+    } else {
+      return _cm_abort(Fcm::Cm::Abort->NULL);
+    }
+
+    # If more than one merge available, prompt user to enter a revision number
+    # to merge from, default to $revs [0]
+    # --------------------------------------------------------------------------
+    if ($non_interactive || @revs == 1) {
+      $source->pegrev($revs[0]);
+    }
+    else {
+      my $reply = $CLI_PROMPT->(
+        {type => q{}, default => $revs[0]}, 'merge', 'MERGE_REV',
+      );
+      if (!defined($reply)) {
+        return _cm_abort();
+      }
+      # Expand revision keyword if necessary
+      if ($reply) {
+        $reply = (Fcm::Keyword::expand($target->project_url(), $reply))[1];
+      }
+      # Check that the reply is a number in the available merges list
+      if (!grep {$_ eq $reply} @revs) {
+        return _cm_err(Fcm::Cm::Exception->MERGE_REV_INVALID, $reply)
+      }
+      $source->pegrev($reply);
+    }
+
+    # If the working copy top is pointing to a sub-directory of a branch,
+    # we need to check whether the merge will result in losing changes made in
+    # other sub-directories of the source.
+    if ($subdir and not $target->allow_subdir_merge_from ($source, $subdir)) {
+      return _cm_err(Fcm::Cm::Exception->MERGE_UNSAFE, $source->url_peg());
+    }
+
+    # Calculate the base of the merge
+    my $base = $target->base_of_merge_from ($source);
+
+    # $source and $base must take into account the sub-directory
+    my $s = Fcm::CmBranch->new (URL => $source->url_peg);
+    my $b = Fcm::CmBranch->new (URL => $base->url_peg);
+
+    $s->subdir ($subdir) if $subdir;
+    $b->subdir ($subdir) if $subdir;
+
+    # Diagnostic
+    $CLI_MESSAGE->('MERGE_CF', $s->path_peg(), $b->path_peg());
+
+    # Delta of the "svn merge" command
+    @delta = ($b->url_peg, $s->url_peg);
+
+    # Template message
+    $mesg = 'Merged into ' . $target->path . ': ' . $source->path_peg .
+            ' cf. ' . $base->path_peg . "\n";
+  }
+
+  # Run "svn merge" in "--dry-run" mode to see the result
+  # ----------------------------------------------------------------------------
+  my @out   = &run_command (
+    [qw/svn merge --dry-run/, @delta],
+    METHOD => 'qx', PRINT => ($dry_run and $verbose),
+  );
+
+  # Abort merge if it will result in no change
+  if (not @out) {
+    return _cm_abort(Fcm::Cm::Abort->NULL);
+  }
+
+  # Report result of "svn merge --dry-run"
+  if ($dry_run || !$non_interactive) {
+    $CLI_MESSAGE->('MERGE_DRY');
+    $CLI_MESSAGE->('SEPARATOR');
+    $CLI_MESSAGE->(q{}, join(q{}, @out));
+    $CLI_MESSAGE->('SEPARATOR');
+  }
+
+  return if $dry_run;
+
+  # Prompt the user to see if (s)he would like to go ahead
+  # ----------------------------------------------------------------------------
+  # Go ahead with merge only if user replies "y"
+  if (!$non_interactive && $CLI_PROMPT->('merge', 'MERGE') ne 'y') {
+    return _cm_abort();
+  }
+  $CLI_MESSAGE->('MERGE');
+  run_command([qw/svn merge/, @delta], PRINT => $verbose);
+
+  # Prepare the commit log
+  # ----------------------------------------------------------------------------
+  # Read in any existing message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->read_file;
+  $ci_mesg->auto_mesg ([$mesg, @{ $ci_mesg->auto_mesg }]);
+  $ci_mesg->write_file;
+
+  if ($verbose) {
+    $CLI_MESSAGE->('SEPARATOR');
+    $CLI_MESSAGE->('MERGE_CI', $mesg);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &Fcm::Cm::cm_mkpatch ();
+#
+# DESCRIPTION
+#   This is a FCM command to create a patching script from particular revisions
+#   of a URL.
+# ------------------------------------------------------------------------------
+
+sub cm_mkpatch {
+  # Process command line options and arguments
+  # ----------------------------------------------------------------------------
+  my (@exclude, $organisation, $revision);
+  my $rc = GetOptions(
+    'exclude=s'      => \@exclude,
+    'organisation=s' => \$organisation,
+    'r|revision=s'   => \$revision,
+  );
+  if (!$rc) {
+    _cli_err();
+  }
+
+  # Excluded paths, convert glob into regular patterns
+  @exclude = split (/:/, join (':', @exclude));
+  for (@exclude) {
+    s#\*#[^/]*#; # match any number of non-slash character
+    s#\?#[^/]#;  # match a non-slash character
+    s#/*$##;     # remove trailing slash
+  }
+
+  # Organisation prefix
+  $organisation = $organisation ? $organisation : 'original';
+
+  # Make sure revision option is set correctly
+  my @revs = $revision ? split (/:/, $revision) : ();
+  @revs    = @revs [0, 1] if @revs > 2;
+
+  # Arguments
+  my ($u, $outdir) = @ARGV;
+
+  if (!$u) {
+    _cli_err();
+  }
+
+  my $url = Fcm::CmUrl->new (URL => $u);
+  if (!$url->is_url()) {
+    return _cm_err(Fcm::Cm::Exception->INVALID_URL, $u);
+  }
+  if (!$url->url_exists()) {
+    return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $u);
+  }
+  if (!$url->branch()) {
+    $CLI_MESSAGE->('INVALID_BRANCH', $u);
+  }
+  elsif ($url->subdir()) {
+    $CLI_MESSAGE->('BRANCH_SUBDIR', $u);
+  }
+
+  if (@revs) {
+    # If HEAD revision is given, convert it into a number
+    # --------------------------------------------------------------------------
+    for my $rev (@revs) {
+      $rev = $url->svninfo (FLAG => 'Revision') if uc ($rev) eq 'HEAD';
+    }
+
+  } else {
+    # If no revision is given, use the HEAD
+    # --------------------------------------------------------------------------
+    $revs[0] = $url->svninfo (FLAG => 'Revision');
+  }
+
+  $revs[1] = $revs[0] if @revs == 1;
+
+  # Check that output directory is set
+  # ----------------------------------------------------------------------------
+  $outdir = File::Spec->catfile (cwd (), 'fcm-mkpatch-out') if not $outdir;
+
+  if (-e $outdir) {
+    # Ask user to confirm removal of old output directory if it exists
+    if ($CLI_PROMPT->('mkpatch', 'MKPATCH_OVERWRITE') ne 'y') {
+      return _cm_abort();
+    }
+
+    rmtree($outdir) || return _cm_err(Fcm::Cm::Exception->RMTREE, $outdir);
+  }
+
+  # (Re-)create output directory
+  mkpath($outdir) || return _cm_err(Fcm::Cm::Exception->MKPATH, $outdir);
+  $CLI_MESSAGE->('OUT_DIR', $outdir);
+
+  # Get and process log of URL
+  # ----------------------------------------------------------------------------
+  my @script   = (); # main output script
+  my %log      = $url->svnlog (REV => \@revs);
+  my $url_path = $url->path;
+
+  for my $rev (sort {$a <=> $b} keys %log) {
+    # Look at the changed paths for each revision
+    my $use_patch = 1;  # OK to use a patch file?
+    my @paths;
+    PATH: for my $path (sort keys %{ $log{$rev}{paths} }) {
+      my $file = $path;
+
+      # Skip paths outside of the branch
+      next PATH unless $file =~ s#^$url_path/*##;
+
+      # Skip excluded paths
+      for my $exclude (@exclude) {
+        if ($file =~ m#^$exclude(?:/*|$)#) {
+          # Can't use a patch file if any files have been excluded
+          $use_patch = 0;
+          next PATH;
+        }
+      }
+
+      # Can't use a patch file if any files have been added or replaced
+      $use_patch = 0 if $log{$rev}{paths}{$path}{action} eq 'A' or
+                        $log{$rev}{paths}{$path}{action} eq 'R';
+
+      push @paths, $path;
+    }
+
+    # If a patch is being used, make sure it isn't just property changes
+    if ($use_patch) {
+      my @changedpaths;
+      for my $path (@paths) {
+        (my $file = $path) =~ s#^$url_path/*##;
+        if ($log{$rev}{paths}{$path}{action} eq 'M') {
+          my ($diff) = &run_command (
+                         [qw/svn diff --no-diff-deleted --summarize -c/,
+                          $rev, $url->url . '/' . $file. '@' . $rev],
+                         METHOD => 'qx');
+          next unless $diff =~ /^[A-Z]/;
+        }
+        push @changedpaths, $path;
+      }
+      @paths = @changedpaths;
+    }
+
+    next unless @paths;
+
+    # Create the patch using "svn diff"
+    my @patch = ();
+    if ($use_patch) {
+      @patch = &run_command ([qw/svn diff --no-diff-deleted -c/, $rev,
+                              $url->url], METHOD => 'qx');
+      if (@patch) {
+        # Don't use the patch if it may contain subversion keywords
+        for (@patch) {
+          $use_patch = 0 if /\$[a-zA-Z:]+ *\$/;
+        }
+      } else {
+        $use_patch = 0;
+      }
+    }
+
+    # Create a directory for this revision in the output directory
+    my $outdir_rev = File::Spec->catfile ($outdir, $rev);
+    mkpath($outdir_rev)
+      || return _cm_err(Fcm::Cm::Exception->MKPATH, $outdir_rev);
+
+    # Parse commit log message
+    my @msg = split /\n/, $log{$rev}{msg};
+    for (@msg) {
+      # Re-instate line break
+      $_ .= "\n";
+
+      # Remove line if it matches a merge template
+      $_ = '' if /^Reversed r\d+(?::\d+)? of \S+$/;
+      $_ = '' if /^Custom merge into \S+:.+$/;
+      $_ = '' if /^Merged into \S+: \S+ cf\. \S+$/;
+
+      # Modify Trac ticket link
+      s/(?:#|ticket:)(\d+)/${organisation}_ticket:$1/g;
+
+      # Modify Trac changeset link
+      s/(?:r|changeset:)(\d+)/${organisation}_changeset:$1/g;
+      s/\[(\d+)\]/${organisation}_changeset:$1/g;
+    }
+
+    push @msg, '(' . $organisation . '_changeset:' . $rev . ')' . "\n";
+
+    # Write commit log message in a file
+    my $f_revlog = File::Spec->catfile ($outdir_rev, 'log-message');
+    open FILE, '>', $f_revlog or die $f_revlog, ': cannot open (', $!, ')';
+    print FILE @msg;
+    close FILE or die $f_revlog, ': cannot close (', $!, ')';
+
+    # Handle each changed path
+    my $export_file   = 1;  # name for next exported file (gets incremented)
+    my $patch_needed  = 0;  # is a patch file required?
+    my @before_script = (); # patch script to run before patch applied
+    my @after_script  = (); # patch script to run after patch applied
+    my @copied_dirs   = (); # copied directories
+    CHANGED: for my $path (@paths) {
+      (my $file = $path) =~ s#^$url_path/*##;
+      my $url_file = $url->url . '/' . $file . '@' . $rev;
+
+      # Skip paths within copied directories
+      for my $copied_dir (@copied_dirs) {
+        next CHANGED if $file =~ m#^$copied_dir(?:/*|$)#;
+      }
+
+      if ($log{$rev}{paths}{$path}{action} eq 'D') {
+        # Script to delete file
+        push @after_script, 'svn delete ' . $file;
+
+      } else {
+        my $export_required = 0;
+        my $recursive_add   = 0;
+        my $is_newfile      = 0;
+
+        # Skip property changes
+        if ($log{$rev}{paths}{$path}{action} eq 'M') {
+          my ($diff) = &run_command (
+                         [qw/svn diff --no-diff-deleted --summarize -c/,
+                          $rev, $url->url . '/' . $file. '@' . $rev],
+                         METHOD => 'qx');
+          next CHANGED unless $diff =~ /^[A-Z]/;
+        }
+
+        # Determine if the file is a directory
+        my $is_dir = 0;
+        if ($log{$rev}{paths}{$path}{action} ne 'M') {
+          my @info = &run_command ([qw/svn info/, $url_file], METHOD => 'qx');
+          for (@info) {
+            if (/^Node Kind: (\w+)/) {
+              $is_dir = 1 if $1 eq 'directory';
+              last;
+            }
+          }
+        }
+
+        # Decide how to treat added files
+        if ($log{$rev}{paths}{$path}{action} eq 'A') {
+          # Determine if the file is copied
+          if (exists $log{$rev}{paths}{$path}{'copyfrom-path'}) {
+            if ($is_dir) {
+              # A copied directory needs to be treated as a new file, exported
+              # and added recursively
+              $is_newfile      = 1;
+              $export_required = 1;
+              $recursive_add   = 1;
+              push @copied_dirs, $file;
+            } else {
+              # History exists for this file
+              my $copyfrom_path = $log{$rev}{paths}{$path}{'copyfrom-path'};
+              my $copyfrom_rev  = $log{$rev}{paths}{$path}{'copyfrom-rev'};
+              my $cp_url = Fcm::CmUrl->new (
+                URL => $url->root . $copyfrom_path . '@' . $copyfrom_rev,
+              );
+
+              if ($copyfrom_path =~ s#^$url_path/*##) {
+                # File is copied from a file under the specified URL
+                # Check source exists
+                $is_newfile = 1 unless $cp_url->url_exists ($rev - 1);
+              } else {
+                # File copied from outside of the specified URL
+                $is_newfile = 1;
+
+                # Check branches can be determined
+                if ($url->branch and $cp_url->branch) {
+
+                  # Follow its history, stop on copy
+                  my %cp_log = $cp_url->svnlog (STOP_ON_COPY => 1);
+
+                  # "First" revision of the copied file
+                  my $cp_rev = (sort {$a <=> $b} keys %cp_log) [0];
+                  my %attrib = %{ $cp_log{$cp_rev}{paths}{$cp_url->path} }
+                    if $cp_log{$cp_rev}{paths}{$cp_url->path};
+
+                  # Check whether the "first" revision is copied from elsewhere.
+                  if (exists $attrib{'copyfrom-path'}) {
+                    # If source exists in the specified URL, set up the copy
+                    my $cp_cp_url = Fcm::CmUrl->new (
+                      URL => $url->root . $attrib{'copyfrom-path'} . '@' .
+                             $attrib{'copyfrom-rev'},
+                    );
+                    $cp_cp_url->branch ($url->branch);
+                    if ($cp_cp_url->url_exists ($rev - 1)) {
+                      ($copyfrom_path = $cp_cp_url->path) =~ s#^$url_path/*##;
+                      # Check path is defined - if not it probably means the
+                      # branch doesn't follow the FCM naming convention
+                      $is_newfile = 0 if $copyfrom_path;
+                    }
+                  }
+
+                  # Note: The logic above does not cover all cases. However, it
+                  # should do the right thing for the most common case. Even
+                  # where it gets it wrong the file contents should always be
+                  # correct even if the file history is not.
+                }
+              }
+
+              # Check whether file is copied from an excluded path
+              if (not $is_newfile) {
+                for my $exclude (@exclude) {
+                  if ($copyfrom_path =~ m#^$exclude(?:/*|$)#) {
+                    $is_newfile = 1;
+                    last;
+                  }
+                }
+              }
+
+              # Script to copy file, if required
+              push @before_script, 'svn copy ' . $copyfrom_path .  ' ' . $file
+                if not $is_newfile;
+            }
+
+          } else {
+            # History does not exist, must be a new file
+            $is_newfile = 1;
+            # If it's a directory then create it (in case patch doesn't)
+            push @before_script, 'mkdir ' . $file if $is_dir;
+          }
+        }
+
+        if ($log{$rev}{paths}{$path}{action} eq 'R') {
+          # Script to delete file
+          push @before_script, 'svn delete ' . $file;
+
+          # Now treat as new file
+          $is_newfile = 1;
+        }
+
+        # Script to add the file, if required
+        if ($is_newfile) {
+          if ($recursive_add) {
+            push @after_script, 'svn add ' . $file;
+          } else {
+            push @after_script, 'svn add --non-recursive ' . $file;
+          }
+        }
+
+        # Decide whether the file needs to be exported
+        if (not $is_dir) {
+          if (not $use_patch) {
+            $export_required = 1;
+          } else {
+            # Export the file if it is binary
+            my @mime_type = &run_command
+             ([qw/svn propget svn:mime-type/, $url_file], METHOD => 'qx');
+            for (@mime_type) {
+              $export_required = 1 if not /^text\//;
+            }
+            # Only create a patch file if necessary
+            $patch_needed = 1 if not $export_required;
+          }
+        }
+
+        if ($export_required) {
+          # Download the file using "svn export"
+          my $export = File::Spec->catfile ($outdir_rev, $export_file);
+          &run_command ([qw/svn export -q -r/, $rev, $url_file, $export]);
+
+          # Copy the exported file into the file
+          push @before_script,
+               'cp -r ${fcm_patch_dir}/' . $export_file . ' ' . $file;
+          $export_file++;
+        }
+      }
+    }
+
+    # Write the patch file
+    if ($patch_needed) {
+      my $patchfile = File::Spec->catfile ($outdir_rev, 'patchfile');
+      open FILE, '>', $patchfile
+        or die $patchfile, ': cannot open (', $!, ')';
+      print FILE @patch;
+      close FILE or die $patchfile, ': cannot close (', $!, ')';
+    }
+
+    # Add line break to each line in @before_script and @after_script
+    @before_script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")}
+                     @before_script if (@before_script);
+    @after_script  = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")}
+                     @after_script if (@after_script);
+
+    # Write patch script to output
+    my $out = File::Spec->catfile ($outdir_rev, 'apply-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    my $shell = Fcm::Config->instance()->setting(qw/TOOL SHELL/);
+    print FILE <<EOF;
+#!$shell
+# ------------------------------------------------------------------------------
+# NAME
+#   apply-patch
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command. It
+#   applies the patch to the current working directory which must be a working
+#   copy of a valid project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+#   Changeset: $rev
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+echo "\$this: Applying patch for changeset $rev."
+
+# Location of the patch, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patch_dir=\$PWD
+
+# Change directory back to the working copy
+cd \$OLDPWD || exit 1
+
+# Check working copy does not have local changes
+status=`svn status`
+if [[ -n \$status ]]; then
+  echo "\$this: working copy contains changes, abort." >&2
+  exit 1
+fi
+if [[ -a "#commit_message#" ]]; then
+  echo "\$this: existing commit message in "#commit_message#", abort." >&2
+  exit 1
+fi
+
+# Apply the changes
+EOF
+
+    # Script content
+    print FILE @before_script if @before_script;
+    print FILE "patch -p0 <\${fcm_patch_dir}/patchfile || exit 1\n"
+      if $patch_needed;
+    print FILE @after_script  if @after_script;
+
+    # Script footer
+    print FILE <<EOF;
+
+# Copy in the commit message
+cp \${fcm_patch_dir}/log-message "#commit_message#"
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Script to commit the change
+    push @script, '${fcm_patches_dir}/' . $rev . '/apply-patch';
+    push @script, 'svn commit -F "#commit_message#"';
+    push @script, 'rm -f "#commit_message#"';
+    push @script, 'svn update';
+    push @script, '';
+
+    $CLI_MESSAGE->('PATCH_REV', $rev);
+  }
+
+  # Write the main output script if necessary. Otherwise remove output directory
+  # ----------------------------------------------------------------------------
+  if (@script) {
+    # Add line break to each line in @script
+    @script = map {($_ ? $_ . ' || exit 1' . "\n" : "\n")} @script;
+
+    # Write script to output
+    my $out = File::Spec->catfile ($outdir, 'fcm-import-patch');
+    open FILE, '>', $out or die $out, ': cannot open (', $!, ')';
+
+    # Script header
+    my $shell = Fcm::Config->instance()->setting(qw/TOOL SHELL/);
+    print FILE <<EOF;
+#!$shell
+# ------------------------------------------------------------------------------
+# NAME
+#   fcm-import-patch
+#
+# SYNOPSIS
+#   fcm-import-patch TARGET
+#
+# DESCRIPTION
+#   This script is generated automatically by the "fcm mkpatch" command, as are
+#   the revision "patches" created in the same directory. The script imports the
+#   patches into TARGET, which must either be a URL or a working copy of a valid
+#   project tree that can accept the import of the patches.
+#
+#   Patch created from $organisation URL: $u
+# ------------------------------------------------------------------------------
+
+this=`basename \$0`
+
+# Check argument
+target=\$1
+
+# First argument must be a URL or working copy
+if [[ -z \$target ]]; then
+  echo "\$this: the first argument must be a URL or a working copy, abort." >&2
+  exit 1
+fi
+
+if [[ \$target == svn://*  || \$target == svn+ssh://* || \\
+      \$target == http://* || \$target == https://*   || \\
+      \$target == file://* ]]; then
+  # A URL, checkout a working copy in a temporary location
+  fcm_tmp_dir=`mktemp -d \${TMPDIR:=/tmp}/\$this.XXXXXX`
+  fcm_working_copy=\$fcm_tmp_dir
+  svn checkout -q \$target \$fcm_working_copy || exit 1
+else
+  fcm_working_copy=\$target
+fi
+
+# Location of the patches, base on the location of this script
+cd `dirname \$0` || exit 1
+fcm_patches_dir=\$PWD
+
+# Change directory to the working copy
+cd \$fcm_working_copy || exit 1
+
+# Set the language to avoid encoding problems
+export LANG=en_GB
+
+# Commands to apply patches
+EOF
+
+    # Script content
+    print FILE @script;
+
+    # Script footer
+    print FILE <<EOF;
+# Remove temporary working copy, if necessary
+if [[ -d \$fcm_tmp_dir && -w \$fcm_tmp_dir ]]; then
+  rm -rf \$fcm_tmp_dir
+fi
+
+echo "\$this: finished normally."
+#EOF
+EOF
+
+    close FILE or die $out, ': cannot close (', $!, ')';
+
+    # Add executable permission
+    chmod 0755, $out;
+
+    # Diagnostic
+    $CLI_MESSAGE->('PATCH_DONE', $outdir);
+
+  } else {
+    # Remove output directory
+    rmtree $outdir or die $outdir, ': cannot remove';
+
+    # Diagnostic
+    return _cm_abort(Fcm::Cm::Abort->NULL);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm add.
+sub _cli_command_add {
+    my @args = map {($_ eq '--check' || $_ eq '-c' ? () : $_)} @_;
+    my %option = (st_check_handler => $CLI_HANDLER_OF{'WC_STATUS_PATH'});
+    return (
+        @args == @_ ? _svn("add", @args) : cm_check_unknown(\%option, @args)
+    );
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm checkout.
+sub _cli_command_checkout {
+    if (@ARGV) {
+        my $target = is_url($ARGV[-1]) ? cwd() : $ARGV[-1];
+        if (-d $target && is_wc($target)) {
+            return _cm_err(Fcm::Cm::Exception->WC_EXIST, $target);
+        }
+    }
+    return _svn('checkout', @ARGV);
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm delete.
+sub _cli_command_delete {
+    my @args = map {($_ eq '--check' || $_ eq '-c' ? () : $_)} @_;
+    my %option = (st_check_handler => $CLI_HANDLER_OF{'WC_STATUS_PATH'});
+    return (
+        @args == @_ ? _svn("delete", @args) : cm_check_missing(\%option, @args)
+    );
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm switch.
+sub _cli_command_switch {
+    local(@ARGV) = @_;
+    if (grep {$_ eq '--relocate'} @ARGV) {
+        return _svn('switch', @ARGV);
+    }
+    my %option;
+    if (!GetOptions(\%option, 'non-interactive', 'revision|r=s', 'quiet|q')) {
+        _cli_err();
+    }
+    if (!$option{'non-interactive'}) {
+        $option{st_check_handler} = $CLI_HANDLER_OF{WC_STATUS};
+    }
+    if (!@ARGV) {
+        _cli_err();
+    }
+    $CLI_MESSAGE->(q{}, join(q{}, cm_switch(\%option, @ARGV)));
+}
+
+# ------------------------------------------------------------------------------
+# CLI: fcm update.
+sub _cli_command_update {
+    local(@ARGV) = @_;
+    my %option;
+    if (!GetOptions(\%option, 'non-interactive', 'revision|r=s', 'quiet|q')) {
+        _cli_err();
+    }
+    if (!$option{'non-interactive'}) {
+        $option{st_check_handler} = $CLI_HANDLER_OF{WC_STATUS};
+    }
+    $CLI_MESSAGE->(q{}, join(q{}, cm_update(\%option, @ARGV)));
+}
+
+# ------------------------------------------------------------------------------
+# CLI error.
+sub _cli_err {
+    my ($key, @args) = @_;
+    $key ||= 'CLI_USAGE';
+    my $message = sprintf($CLI_MESSAGE_FOR_ERROR{$key}, @args);
+    die(Fcm::CLI::Exception->new({message => $message}));
+}
+
+# ------------------------------------------------------------------------------
+# Handles abort exception.
+sub _cli_e_handler_of_cm_abort {
+    my ($function, $e) = @_;
+    if ($e->get_code() eq $e->FAIL) {
+        die(sprintf($CLI_MESSAGE_FOR_ABORT{FAIL}, $function));
+    }
+    else {
+        $CLI_MESSAGE->($e->get_code(), $function);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Handles CM exception.
+sub _cli_e_handler_of_cm_exception {
+    my ($function, $e) = @_;
+    die(sprintf($CLI_MESSAGE_FOR_ERROR{$e->get_code()}, $e->get_targets()));
+}
+
+# ------------------------------------------------------------------------------
+# Handles CLI exception.
+sub _cli_e_handler_of_cli_exception {
+    my ($function, $e) = @_;
+    $CLI_MESSAGE->('CLI', $e);
+    $CLI_MESSAGE->('CLI_HELP', $function);
+}
+
+# ------------------------------------------------------------------------------
+# The default handler of the "WC_STATUS" event.
+sub _cli_handler_of_wc_status {
+    my ($name, $target_list_ref, $status_list_ref) = @_;
+    if (@{$status_list_ref}) {
+        $CLI_MESSAGE->('STATUS', join(q{}, @{$status_list_ref}));
+        if ($CLI_PROMPT->($name, 'CONTINUE') ne 'y') {
+            return _cm_abort();
+        }
+    }
+    return @{$status_list_ref};
+}
+
+# ------------------------------------------------------------------------------
+# The default handler of the "WC_STATUS_PATH" event.
+sub _cli_handler_of_wc_status_path {
+    my ($name, $target_list_ref, $status_list_ref) = @_;
+    $CLI_MESSAGE->(q{}, join(q{}, @{$status_list_ref}));
+    my @paths = map {chomp(); ($_ =~ $PATTERN_OF{ST_PATH})} @{$status_list_ref};
+    my @paths_of_interest;
+    while (my $path = shift(@paths)) {
+        my %handler_of = (
+            a => sub {push(@paths_of_interest, $path, @paths); @paths = ()},
+            n => sub {},
+            y => sub {push(@paths_of_interest, $path)},
+        );
+        my $reply = $CLI_PROMPT->(
+            {type => 'yna'}, $name, 'RUN_SVN_COMMAND', "$name $path",
+        );
+        $handler_of{$reply}->();
+    }
+    return @paths_of_interest;
+}
+
+# ------------------------------------------------------------------------------
+# Prints help for a given $subcommand.
+sub _cli_help {
+    my ($key, $exit_val) = @_;
+    my $pod
+        = File::Spec->catfile(dirname($INC{'Fcm/Cm.pm'}), 'CLI', "fcm-$key.pod");
+    my $has_pod = -f $pod;
+    if ($has_pod) {
+        pod2usage({
+            '-exitval' => defined($exit_val) ? $exit_val : 2,
+            '-input'   => $pod,
+            '-verbose' => 1,
+        });
+    }
+    if (!$has_pod || exists($CLI_MORE_HELP_FOR{$key})) {
+        local(@ARGV) = ($key);
+        return _svn('help', $key);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Expands location keywords in a list.
+sub _cli_keyword_expand_url {
+    my ($arg_list_ref) = @_;
+    ARG:
+    for my $arg (@{$arg_list_ref}) {
+        my ($label, $value) = ($arg =~ $PATTERN_OF{CLI_OPT});
+        if (!$label) {
+            ($label, $value) = (q{}, $arg);
+        }
+        if (!$value) {
+            next ARG;
+        }
+        eval {
+            $value = Fcm::Util::tidy_url(Fcm::Keyword::expand($value));
+        };
+        if ($@) {
+            if ($value ne 'fcm:revision') {
+                die($@);
+            }
+        }
+        $arg = $label . $value;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Expands revision keywords in -r and --revision options in a list.
+sub _cli_keyword_expand_rev {
+    my ($arg_list_ref) = @_;
+    my @targets;
+    for my $arg (@{$arg_list_ref}) {
+        if (-e $arg && is_wc($arg) || is_url($arg)) {
+            push(@targets, $arg);
+        }
+    }
+    if (!@targets) {
+        push(@targets, get_url_of_wc());
+    }
+    if (!@targets) {
+        return;
+    }
+    my @old_arg_list = @{$arg_list_ref};
+    my @new_arg_list = ();
+    ARG:
+    while (defined(my $arg = shift(@old_arg_list))) {
+        my ($key, $value) = $arg =~ $PATTERN_OF{CLI_OPT_REV};
+        if (!$key) {
+            push(@new_arg_list, $arg);
+            next ARG;
+        }
+        push(@new_arg_list, '--revision');
+        if (!$value) {
+            $value = shift(@old_arg_list);
+        }
+        my @revs = grep {defined()} ($value =~ $PATTERN_OF{CLI_OPT_REV_RANGE});
+        my ($url, @url_list) = @targets;
+        for my $rev (@revs) {
+            if ($rev !~ $PATTERN_OF{SVN_REV}) {
+                $rev = (Fcm::Keyword::expand($url, $rev))[1];
+            }
+            if (@url_list) {
+                $url = shift(@url_list);
+            }
+        }
+        push(@new_arg_list, join(q{:}, @revs));
+    }
+    @{$arg_list_ref} = @new_arg_list;
+}
+
+# ------------------------------------------------------------------------------
+# Prints a message.
+sub _cli_message {
+    my ($key, @args) = @_;
+    for (
+        [\*STDOUT, \%CLI_MESSAGE_FOR        , q{}          ],
+        [\*STDERR, \%CLI_MESSAGE_FOR_WARNING, q{[WARNING] }],
+        [\*STDERR, \%CLI_MESSAGE_FOR_ABORT  , q{[ABORT] }  ],
+        [\*STDERR, \%CLI_MESSAGE_FOR_ERROR  , q{[ERROR] }  ],
+    ) {
+        my ($handle, $hash_ref, $prefix) = @{$_};
+        if (exists($hash_ref->{$key})) {
+            return printf({$handle} $prefix . $hash_ref->{$key}, @args);
+        }
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Wrapper for Fcm::Interactive::get_input.
+sub _cli_prompt {
+    my %option
+        = (type => 'yn', default => 'n', (ref($_[0]) ? %{shift(@_)} : ()));
+    my ($name, $key, @args) = @_;
+    return Fcm::Interactive::get_input(
+        title   => $CLI_PROMPT_PREFIX . $name,
+        message => sprintf($CLI_MESSAGE_FOR_PROMPT{$key}, @args),
+        %option,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Check missing status and delete.
+sub cm_check_missing {
+    my %option = %{shift()};
+    my $checker
+        = _svn_status_checker('delete', 'MISSING', $option{st_check_handler});
+    my @paths = $checker->(\@_);
+    if (@paths) {
+        run_command([qw{svn delete}, @paths]);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Check unknown status and add.
+sub cm_check_unknown {
+    my %option = %{shift()};
+    my $checker
+        = _svn_status_checker('add', 'UNKNOWN', $option{st_check_handler});
+    my @paths = $checker->(\@_);
+    if (@paths) {
+        run_command([qw{svn add}, @paths]);
+    }
+}
+
+# ------------------------------------------------------------------------------
+# FCM wrapper to SVN switch.
+sub cm_switch {
+    my %option = %{shift()};
+    my ($target, $path) = @_;
+    $path ||= cwd();
+    if (!-e $path) {
+        return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $path);
+    }
+    if (!is_wc($path)) {
+        return _cm_err(Fcm::Cm::Exception->INVALID_WC, $path);
+    }
+
+    # Check for merge template in the commit log file in the working copy
+    my $path_of_wc = get_wct($path);
+    my $ci_mesg = Fcm::CmCommitMessage->new();
+    $ci_mesg->dir($path_of_wc);
+    $ci_mesg->read_file();
+    if (@{$ci_mesg->auto_mesg()}) {
+        return _cm_err(
+            Fcm::Cm::Exception->SWITCH_UNSAFE,
+            $path eq $path_of_wc ? $ci_mesg->base() : $ci_mesg->file(),
+        );
+    }
+
+    # Check for any local modifications
+    if (defined($option{st_check_handler})) {
+        my $handler = $CLI_HANDLER_OF{WC_STATUS};
+        _svn_status_checker('switch', 'MODIFIED', $handler)->([$path_of_wc]);
+    }
+
+    # Invokes "svn switch"
+    _svn(
+        {METHOD => 'qx', PRINT => !$option{quiet}},
+        'switch',
+        ($option{'non-interactive'} ? '--non-interactive'       : ()),
+        ($option{revision}          ? ('-r', $option{revision}) : ()),
+        ($option{quiet}             ? '--quiet'                 : ()),
+        _cm_get_source(
+            $target,
+            Fcm::CmBranch->new(URL => get_url_of_wc($path_of_wc)),
+        )->url_peg(),
+        ($path_of_wc eq cwd() ? () : $path_of_wc),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# FCM wrapper to SVN update.
+sub cm_update {
+    my %option = %{shift()};
+    my @targets = @_;
+    if (!@targets) {
+        @targets = (cwd());
+    }
+    for my $target (@targets) {
+        if (!-e $target) {
+            return _cm_err(Fcm::Cm::Exception->NOT_EXIST, $target);
+        }
+        if (!is_wc($target)) {
+            return _cm_err(Fcm::Cm::Exception->INVALID_WC, $target);
+        }
+        $target = get_wct($target);
+        if ($target eq cwd()) {
+            $target = q{.};
+        }
+    }
+    if (defined($option{st_check_handler})) {
+        my ($matcher_keys_ref, $show_updates)
+            = defined($option{revision}) ? (['MODIFIED'               ], undef)
+            :                              (['MODIFIED', 'OUT_OF_DATE'], 1    )
+            ;
+        my $matcher = sub {
+            for my $key (@{$matcher_keys_ref}) {
+                $ST_MATCHER_FOR{$key}->(@_) && return 1;
+            }
+        };
+        _svn_status_checker(
+            'update', $matcher, $option{st_check_handler}, $show_updates,
+        )->(\@targets);
+    }
+    if ($option{revision} && $option{revision} !~ $PATTERN_OF{SVN_REV}) {
+        $option{revision} = (
+            Fcm::Keyword::expand(get_url_of_wc($targets[0]), $option{revision})
+        )[1];
+    }
+    return _svn_update(\@targets, \%option);
+}
+
+# ------------------------------------------------------------------------------
+# Raises an abort exception.
+sub _cm_abort {
+    my ($code) = @_;
+    $code ||= Fcm::Cm::Abort->USER;
+    die(bless({code => $code, message => 'abort'}, 'Fcm::Cm::Abort'));
+}
+
+# ------------------------------------------------------------------------------
+# Raises a failure.
+sub _cm_err {
+    my ($code, @targets) = @_;
+    die(bless(
+        {code => $code, message => "ERROR: $code", targets => \@targets},
+        'Fcm::Cm::Exception',
+    ));
+}
+
+# ------------------------------------------------------------------------------
+# Returns the corresponding Fcm::CmBranch instance for $src_url w.r.t. $target.
+sub _cm_get_source {
+    my ($src_url, $target) = @_;
+    my $source = Fcm::CmBranch->new(URL => $src_url);
+    if (!$source->is_url()) {
+        # Not a full URL, construct full URL based on current URL
+        $source->url_peg($target->url_peg());
+        my $project = $target->project();
+        my ($path) = $src_url =~ qr{\A/*(.*)\z}xms;
+        if (index($path, $project) == 0) {
+            # Argument contains the full path under the repository root
+            $path = substr($path, length($project));
+        }
+        if ($path =~ $PATTERN_OF{FCM_BRANCH_PATH}) {
+            # Argument contains the full branch name
+            $path = join(q{/}, $target->project_path(), $path);
+        }
+        else {
+            # Argument contains the shorter branch name
+            $path = join(q{/}, $target->project_path(), 'branches', $path);
+        }
+        $source->path_peg($path);
+    }
+    # Replace source sub-directory with the target sub-directory
+    $source->subdir($target->subdir());
+    # Ensure that the branch name exists
+    if (!$source->url_exists()) {
+        return _cm_err(Fcm::Cm::Exception->INVALID_URL, $src_url);
+    }
+    # Ensure that the branch name is valid
+    if (!$source->branch()) {
+        return _cm_err(Fcm::Cm::Exception->INVALID_BRANCH, $src_url);
+    }
+    # Ensure that the source and target URLs are in the same project
+    if ($source->project_url() ne $target->project_url()) {
+        return _cm_err(
+            Fcm::Cm::Exception->DIFF_PROJECTS,
+            $target->url_peg(),
+            $source->url_peg(),
+        );
+    }
+    return $source;
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn".
+sub _svn {
+    my @args = @_;
+    my %option;
+    if (@args && ref($args[0])) {
+        %option = %{shift(@args)};
+    }
+    return run_command(
+        ['svn', @args],
+        PRINT => ($args[0] ne 'cat' && !grep {$_ eq '--xml'} @args),
+        %option,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns the results of "svn status".
+sub _svn_status_get {
+    my ($target_list_ref, $show_updates) = @_;
+    my @targets = (defined($target_list_ref) ? @{$target_list_ref} : ());
+    for my $target (@targets) {
+        if ($target eq cwd()) {
+            $target = q{.};
+        }
+    }
+    my @options = ($show_updates ? qw{--show-updates} : ());
+    return _svn({METHOD => 'qx', PRINT => 0}, 'status', @options, @targets);
+}
+
+# ------------------------------------------------------------------------------
+# Returns a "svn status" checker.
+sub _svn_status_checker {
+    my ($name, $matcher, $handler, $show_updates) = @_;
+    if (!ref($matcher)) {
+        $matcher = $ST_MATCHER_FOR{$matcher};
+    }
+    return sub {
+        my ($target_list_ref) = @_;
+        my @status = _svn_status_get($target_list_ref, $show_updates);
+        if ($show_updates) {
+            @status = map {$_ =~ $PATTERN_OF{ST_AGAINST_REV} ? () : $_} @status;
+        }
+        my @status_of_interest = grep {$matcher->($_)} @status;
+        if (defined($handler)) {
+            return $handler->($name, $target_list_ref, \@status_of_interest);
+        }
+        return @status_of_interest;
+    }
+}
+
+# ------------------------------------------------------------------------------
+# Runs "svn update".
+sub _svn_update {
+    my ($target_list_ref, $option_hash_ref) = @_;
+    my %option = (defined($option_hash_ref) ? %{$option_hash_ref} : ());
+    _svn(
+        {METHOD => 'qx', PRINT => !$option{quiet}},
+        'update',
+        ($option{'non-interactive'} ? '--non-interactive'       : ()),
+        ($option{revision}          ? ('-r', $option{revision}) : ()),
+        ($option{quiet}             ? '--quiet'                 : ()),
+        (defined($target_list_ref) ? @{$target_list_ref} : ()),
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Abort exception.
+package Fcm::Cm::Abort;
+use base qw{Fcm::Exception};
+use constant {FAIL => 'FAIL', NULL => 'NULL', USER => 'USER'};
+
+sub get_code {
+    return $_[0]->{code};
+}
+
+# ------------------------------------------------------------------------------
+# Resource exception.
+package Fcm::Cm::Exception;
+our @ISA = qw{Fcm::Cm::Abort};
+use constant {
+    CHDIR             => 'CHDIR',
+    INVALID_BRANCH    => 'INVALID_BRANCH',
+    INVALID_PROJECT   => 'INVALID_PROJECT',
+    INVALID_TARGET    => 'INVALID_TARGET',
+    INVALID_URL       => 'INVALID_URL',
+    INVALID_WC        => 'INVALID_WC',
+    MERGE_REV_INVALID => 'MERGE_REV_INVALID',
+    MERGE_SELF        => 'MERGE_SELF',
+    MERGE_UNRELATED   => 'MERGE_UNRELATED',
+    MERGE_UNSAFE      => 'MERGE_UNSAFE',
+    MKPATH            => 'MKPATH',
+    NOT_EXIST         => 'NOT_EXIST',
+    PARENT_NOT_EXIST  => 'PARENT_NOT_EXIST',
+    RMTREE            => 'RMTREE',
+    SWITCH_UNSAFE     => 'SWITCH_UNSAFE',
+    WC_EXIST          => 'WC_EXIST',
+    WC_INVALID_BRANCH => 'WC_INVALID_BRANCH',
+    WC_URL_NOT_EXIST  => 'WC_URL_NOT_EXIST',
+};
+
+sub get_targets {
+    return @{$_[0]->{targets}};
+}
+
+1;
+__END__
+
+=pod
+
+=head1 NAME
+
+Fcm::Cm
+
+=head1 SYNOPSIS
+
+    use Fcm::Cm qw{cli};
+
+    # Use as a wrapper to Subversion, and other FCM code management commands
+    cli('info', '--revision', 'HEAD', $url);
+
+    use Fcm::Cm qw{cm_check_missing cm_check_unknown cm_switch cm_update};
+
+    # Checks status for "missing" items and "svn delete" them
+    $missing_st_handler = sub {
+        my ($name, $target_list_ref, $status_list_ref) = @_;
+        # ...
+        return @paths_of_interest;
+    };
+    cm_check_missing({st_check_handler => $missing_st_handler}, @targets);
+
+    # Checks status for "unknown" items and "svn add" them
+    $unknown_st_handler = sub {
+        my ($name, $target_list_ref, $status_list_ref) = @_;
+        # ...
+        return @paths_of_interest;
+    };
+    cm_check_unknown({st_check_handler => $unknown_st_handler}, @targets);
+
+    # Sets up a status checker
+    $st_check_handler = sub {
+        my ($name, $target_list_ref, $status_list_ref) = @_;
+        # ...
+    };
+    # Switches a "working copy" at the "root" level to a new URL target
+    cm_switch(
+        {
+            'non-interactive'  => $non_interactive_flag,
+            'quiet'            => $quiet_flag,
+            'revision'         => $revision,
+            'st_check_handler' => $st_check_handler,
+        },
+        $target, $path_of_wc,
+    );
+    # Runs "svn update" on each working copy from their "root" level
+    cm_update(
+        {
+            'non-interactive'  => $non_interactive_flag,
+            'quiet'            => $quiet_flag,
+            'revision'         => $revision,
+            'st_check_handler' => $st_check_handler,
+        },
+        @targets,
+    );
+
+=head1 DESCRIPTION
+
+Wraps the Subversion client and implements other FCM code management
+functionalities.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item cli($function,@args)
+
+Implements the FCM code management CLI. If --help or -h is specified in @args,
+it displays help and returns.  Otherwise, it attempts to expand any FCM location
+and revision keywords in @args. Calls the relevant FCM code management function
+according to $function, or a SVN command if $function is not modified by FCM.
+
+=item cm_check_missing(\%option,@targets)
+
+Use "svn status" to check for missing items in @targets. If @targets is an empty
+list, the function adds the current working directory to it. Expects
+$option{st_check_handler} to be a CODE reference. Calls
+$option{st_check_handler} with ($name, $target_list_ref, $status_list_ref) where
+$name is "delete", $target_list_ref is \@targets, and $status_list_ref is an
+ARRAY reference to a list of "svn status" output with the "missing" status.
+$option{st_check_handler} should return a list of interesting paths, which will
+be scheduled for removal using "svn delete".
+
+=item cm_check_unknown(\%option,@targets)
+
+Similar to cm_check_missing(\%option,@targets) but checks for "unknown" items,
+which will be scheduled for addition using "svn add".
+
+=item cm_switch(\%option,$target,$path_of_wc)
+
+Invokes "svn switch" at the root of a working copy specified by $path_of_wc (or
+the current working directory if $path_of_wc is not specified).
+$option{'non-interactive'}, $option{quiet}, $option{revision} determines the
+options (of the same name) that are passed to "svn switch". If
+$option{st_check_handler} is set, it should be a CODE reference, and will be
+called with ('switch', [$path_of_wc], $status_list_ref), where $status_list_ref
+is an ARRAY reference to the output returned by "svn status" on $path_of_wc.
+This can be used for the application to display the working copy status to the
+user before prompting him/her to continue. The return value of
+$option{st_check_handler} is ignored.
+
+=item cm_update(\%option,@targets)
+
+Invokes "svn update" at the root of each working copy specified by @targets. If
+@targets is an empty list, the function adds the current working directory to
+it. $option{'non-interactive'}, $option{quiet}, $option{revision} determines the
+options (of the same name) that are passed to "svn update". If
+$option{st_check_handler} is set, it should be a CODE reference, and will be
+called with ($name, $target_list_ref, $status_list_ref), where $name is
+'update', $target_list_ref is \@targets and $status_list_ref is an ARRAY
+reference to the output returned by "svn status -u" on the @targets. This can be
+used for the application to display the working copy update status to the user
+before prompting him/her to continue. The return value of
+$option{st_check_handler} is ignored.
+
+=back
+
+=head1 DIAGNOSTICS
+
+The following exceptions can be raised:
+
+=over 4
+
+=item Fcm::Cm::Abort
+
+This exception @ISA L<Fcm::Exception|Fcm::Exception>. It is raised if a command
+is aborted for some reason. The $e->get_code() method can be used to retrieve an
+error code, which can be one of the following:
+
+=over 4
+
+=item $e->FAIL
+
+The command aborts because of a failure.
+
+=item $e->NULL
+
+The command aborts because it will result in no change.
+
+=item $e->USER
+
+The command aborts because of an action by the user.
+
+=back
+
+=item Fcm::Cm::Exception
+
+This exception @ISA L<Fcm::Abort|Fcm::Abort>. It is raised if a command fails
+with a known reason. The $e->get_targets() method can be used to retrieve a list
+of targets/resources associated with this exception. The $e->get_code() method
+can be used to retrieve an error code, which can be one of the following:
+
+=over 4
+
+=item $e->CHDIR
+
+Fails to change directory to a target.
+
+=item $e->INVALID_BRANCH
+
+A target is not a valid branch URL in the standard FCM project layout.
+
+=item $e->INVALID_PROJECT
+
+A target is not a valid project URL in the standard FCM project layout.
+
+=item $e->INVALID_TARGET
+
+A target is not a valid Subversion URL or working copy.
+
+=item $e->INVALID_URL
+
+A target is not a valid Subversion URL.
+
+=item $e->INVALID_WC
+
+A target is not a valid Subversion working copy.
+
+=item $e->MERGE_REV_INVALID
+
+An invalid revision (target element 0) is specified for a merge.
+
+=item $e->MERGE_SELF
+
+Attempt to merge a URL (target element 0) to its own working copy (target
+element 1).
+
+=item $e->MERGE_UNRELATED
+
+The merge target (target element 0) is not directly related to the merge source
+(target element 1).
+
+=item $e->MERGE_UNSAFE
+
+A merge source (target element 0) contains changes outside the target
+sub-directory.
+
+=item $e->MKPATH
+
+Fail to create a directory (target element 0) recursively.
+
+=item $e->NOT_EXIST
+
+A target does not exist.
+
+=item $e->PARENT_NOT_EXIST
+
+The parent of the target no longer exists.
+
+=item $e->RMTREE
+
+Fail to remove a directory (target element 0) recursively.
+
+=item $e->SWITCH_UNSAFE
+
+A merge template exists in the commit message file (target element 0) in a
+working copy target.
+
+=item $e->WC_EXIST
+
+The target working copy already exists.
+
+=item $e->WC_INVALID_BRANCH
+
+The URL of the target working copy is not a valid branch URL in the standard FCM
+project layout.
+
+=item $e->WC_URL_NOT_EXIST
+
+The URL of the target working copy no longer exists at the HEAD revision.
+
+=back
+
+=back
+
+=head1 TO DO
+
+Reintegrate with L<Fcm::CmUrl|Fcm::CmUrl> and L<Fcm::CmBranch|Fcm::CmBranch>,
+but separate this module into the CLI part and the CM part. Expose the remaining
+CM functions when this is done.
+
+Use L<SVN::Client|SVN::Client> to interface with Subversion.
+
+Move C<mkpatch> out of this module.
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/CmBranch.pm
===================================================================
--- vendors/FCM/lib/Fcm/CmBranch.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CmBranch.pm	(revision 9621)
@@ -0,0 +1,1217 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmBranch
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a branch. It is a sub-class of
+#   Fcm::CmUrl, and inherits all methods from that class.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmBranch;
+@ISA = qw(Fcm::CmUrl);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CmCommitMessage;
+use Fcm::CmUrl;
+use Fcm::Config;
+use Fcm::Interactive;
+use Fcm::Keyword;
+use Fcm::Util qw/run_command e_report w_report svn_date/;
+
+my @properties = (
+  'CREATE_REV',  # revision at which the branch is created
+  'DELETE_REV',  # revision at which the branch is deleted
+  'PARENT',      # reference to parent branch Fcm::CmBranch
+  'ANCESTOR',    # list of common ancestors with other branches
+                 # key = URL, value = ancestor Fcm::CmBranch
+  'LAST_MERGE',  # list of last merges from branches
+                 # key = URL@REV, value = [TARGET, UPPER, LOWER]
+  'AVAIL_MERGE', # list of available revisions for merging
+                 # key = URL@REV, value = [REV ...]
+  'CHILDREN',    # list of children of this branch
+  'SIBLINGS',    # list of siblings of this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch = Fcm::CmBranch->new (URL => $url,);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmBranch class.
+#
+# ARGUMENTS
+#   URL    - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::CmUrl->new (%args);
+
+  $self->{$_} = undef for (@properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_branch->url_peg;
+#   $cm_branch->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL and other essential variables in the SUPER-class
+      $self->SUPER::url_peg (@_);
+
+      # Re-set essential variables
+      $self->{$_} = undef for (@properties);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->create_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was created.
+# ------------------------------------------------------------------------------
+
+sub create_rev {
+  my $self = shift;
+
+  if (not $self->{CREATE_REV}) {
+    return unless $self->url_exists ($self->pegrev);
+
+    # Use "svn log" to find out the first revision of the branch
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+
+    # Look at log in ascending order
+    my $rev   = (sort {$a <=> $b} keys %log) [0];
+    my $paths = $log{$rev}{paths};
+
+    # Get revision when URL is first added to the repository
+    if (exists $paths->{$self->branch_path}) {
+      $self->{CREATE_REV} = $rev if $paths->{$self->branch_path}{action} eq 'A';
+    }
+  }
+
+  return $self->{CREATE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $parent = $cm_branch->parent;
+#
+# DESCRIPTION
+#   This method returns the parent (a Fcm::CmBranch object) of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub parent {
+  my $self = shift;
+
+  if (not $self->{PARENT}) {
+    # Use the log to find out the parent revision
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    if (exists $log{paths}{$self->branch_path}) {
+      my $path = $log{paths}{$self->branch_path};
+
+      if ($path->{action} eq 'A') {
+        if (exists $path->{'copyfrom-path'}) {
+          # Current branch is copied from somewhere, set the source as the parent
+          my $url = $self->root .  $path->{'copyfrom-path'};
+          my $rev = $path->{'copyfrom-rev'};
+          $self->{PARENT} = Fcm::CmBranch->new (URL => $url . '@' . $rev);
+
+        } else {
+          # Current branch is not copied from somewhere
+          $self->{PARENT} = $self;
+        }
+      }
+    }
+  }
+
+  return $self->{PARENT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_branch->delete_rev;
+#
+# DESCRIPTION
+#   This method returns the revision at which the branch was deleted.
+# ------------------------------------------------------------------------------
+
+sub delete_rev {
+  my $self = shift;
+
+  if (not $self->{DELETE_REV}) {
+    return if $self->url_exists ('HEAD');
+
+    # Container of the current URL
+    (my $dir_url = $self->branch_url) =~ s#/+[^/]+/*$##;
+
+    # Use "svn log" on the container between a revision where the branch exists
+    # and the HEAD
+    my $dir = Fcm::CmUrl->new (URL => $dir_url);
+    my %log = $dir->svnlog (
+      REV => ['HEAD', ($self->pegrev ? $self->pegrev : $self->create_rev)],
+    );
+
+    # Go through the log to see when branch no longer exists
+    for my $rev (sort {$a <=> $b} keys %log) {
+      next unless exists $log{$rev}{paths}{$self->branch_path} and
+                  $log{$rev}{paths}{$self->branch_path}{action} eq 'D';
+
+      $self->{DELETE_REV} = $rev;
+      last;
+    }
+  }
+
+  return $self->{DELETE_REV};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_child_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a child of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_child_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a child branch
+  return if $self->is_trunk;
+
+  # If $branch is a branch, use name of $self to see when it is created
+  if ($branch->is_branch and $self->url =~ m#/r(\d+)_[^/]+/*$#) {
+    my $rev = $1;
+
+    # $self can only be a child if it is copied from a revision > the create
+    # revision of $branch
+    return if $rev < $branch->create_rev;
+  }
+
+  return if $self->parent->url ne $branch->url;
+
+  # If $branch is a branch, ensure that it is created before $self
+  return if $branch->is_branch and $self->create_rev <= $branch->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->is_sibling_of ($branch);
+#
+# DESCRIPTION
+#   This method returns true if the current branch is a sibling of $branch.
+# ------------------------------------------------------------------------------
+
+sub is_sibling_of {
+  my ($self, $branch) = @_;
+
+  # The trunk cannot be a sibling branch
+  return if $branch->is_trunk;
+
+  return if $self->parent->url ne $branch->parent->url;
+
+  # If the parent is a branch, ensure they are actually the same branch
+  return if $branch->parent->is_branch and
+            $self->parent->create_rev != $branch->parent->create_rev;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_get_relatives ($relation);
+#
+# DESCRIPTION
+#   This method sets the $self->{$relation} variable by inspecting the list of
+#   branches at the current revision of the current branch. $relation can be
+#   either "CHILDREN" or "SIBLINGS".
+# ------------------------------------------------------------------------------
+
+sub _get_relatives {
+  my ($self, $relation) = @_;
+
+  my @branch_list = $self->branch_list;
+
+  $self->{$relation} = [];
+
+  # If we are searching for CHILDREN, get list of SIBLINGS, and vice versa
+  my $other = ($relation eq 'CHILDREN' ? 'SIBLINGS' : 'CHILDREN');
+  my %other_list;
+  if ($self->{$other}) {
+    %other_list = map {$_->url, 1} @{ $self->{$other} };
+  }
+
+  for my $u (@branch_list) {
+    # Ignore URL of current branch and its parent
+    next if $u eq $self->url;
+    next if $self->is_branch and $u eq $self->parent->url;
+
+    # Ignore if URL is a branch detected to be another type of relative
+    next if exists $other_list{$u};
+
+    # Construct new Fcm::CmBranch object from branch URL
+    my $url = $u . ($self->pegrev ? '@' . $self->pegrev : '');
+    my $branch = Fcm::CmBranch->new (URL => $url);
+
+    # Test whether $branch is a relative we are looking for
+    if ($relation eq 'CHILDREN') {
+      push @{ $self->{$relation} }, $branch if $branch->is_child_of ($self);
+
+    } else {
+      push @{ $self->{$relation} }, $branch if $branch->is_sibling_of ($self);
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @children = $cm_branch->children;
+#
+# DESCRIPTION
+#   This method returns a list of children (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub children {
+  my $self = shift;
+
+  $self->_get_relatives ('CHILDREN') if not $self->{CHILDREN};
+
+  return @{ $self->{CHILDREN} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @siblings = $cm_branch->siblings;
+#
+# DESCRIPTION
+#   This method returns a list of siblings (Fcm::CmBranch objects) of the
+#   current branch that exists in the current revision.
+# ------------------------------------------------------------------------------
+
+sub siblings {
+  my $self = shift;
+
+  $self->_get_relatives ('SIBLINGS') if not $self->{SIBLINGS};
+
+  return @{ $self->{SIBLINGS} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ancestor = $cm_branch->ancestor ($branch);
+#
+# DESCRIPTION
+#   This method returns the common ancestor (a Fcm::CmBranch object) of a
+#   specified $branch and the current branch. The argument $branch must be a
+#   Fcm::CmBranch object. Both the current branch and $branch are assumed to be
+#   in the same project.
+# ------------------------------------------------------------------------------
+
+sub ancestor {
+  my ($self, $branch) = @_;
+
+  if (not exists $self->{ANCESTOR}{$branch->url_peg}) {
+    if ($self->url_peg eq $branch->url_peg) {
+      $self->{ANCESTOR}{$branch->url_peg} = $self;
+
+    } else {
+      # Get family tree of current branch, from trunk to current branch
+      my @this_family = ($self);
+      while (not $this_family [0]->is_trunk) {
+        unshift @this_family, $this_family [0]->parent;
+      }
+
+      # Get family tree of $branch, from trunk to $branch
+      my @that_family = ($branch);
+      while (not $that_family [0]->is_trunk) {
+        unshift @that_family, $that_family [0]->parent;
+      }
+
+      # Find common ancestor from list of parents
+      my $ancestor = undef;
+
+      while (not $ancestor) {
+        # $this and $that should both start as some revisions on the trunk.
+        # Walk down a generation each time it loops around.
+        my $this = shift @this_family;
+        my $that = shift @that_family;
+
+        if ($this->url eq $that->url) {
+          if ($this->is_trunk or $this->create_rev eq $that->create_rev) {
+            # $this and $that are the same branch
+            if (@this_family and @that_family) {
+              # More generations in both branches, try comparing the next
+              # generations.
+              next;
+
+            } else {
+              # End of lineage in one of the branches, ancestor is at the lower
+              # revision of the current URL.
+              if ($this->pegrev and $that->pegrev) {
+                $ancestor = $this->pegrev < $that->pegrev ? $this : $that;
+
+              } else {
+                $ancestor = $this->pegrev ? $this : $that;
+              }
+            }
+
+          } else {
+            # Despite the same URL, $this and $that are different branches as
+            # they are created at different revisions. The ancestor must be the
+            # parent with the lower revision. (This should not occur at the
+            # start.)
+            $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                        ? $this->parent : $that->parent;
+          }
+
+        } else {
+          # Different URLs, ancestor must be the parent with the lower revision.
+          # (This should not occur at the start.)
+          $ancestor = $this->parent->pegrev < $that->parent->pegrev
+                      ? $this->parent : $that->parent;
+        }
+      }
+
+      $self->{ANCESTOR}{$branch->url_peg} = $ancestor;
+    }
+  }
+
+  return $self->{ANCESTOR}{$branch->url_peg};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($target, $upper, $lower) = $cm_branch->last_merge_from (
+#     $branch, $stop_on_copy,
+#   );
+#
+# DESCRIPTION
+#   This method returns a 3-element list with information of the last merge
+#   into the current branch from a specified $branch. The first element in the
+#   list $target (a Fcm::CmBranch object) is the target at which the merge was
+#   performed. (This can be the current branch or a parent branch up to the
+#   common ancestor with the specified $branch.) The second and third elements,
+#   $upper and $lower, (both Fcm::CmBranch objects), are the upper and lower
+#   ends of the source delta. If there is no merge from $branch into the
+#   current branch from their common ancestor to the current revision, this
+#   method will return an empty list. If $stop_on_copy is specified, it ignores
+#   merges from parents of $branch, and merges into parents of the current
+#   branch.
+# ------------------------------------------------------------------------------
+
+sub last_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{LAST_MERGE}{$branch->url_peg}) {
+    # Get "log" of current branch down to the common ancestor
+    my %log = $self->svnlog (
+      REV => [
+       ($self->pegrev ? $self->pegrev : 'HEAD'),
+       $self->ancestor ($branch)->pegrev,
+      ],
+
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    my $cr = $self;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      # Also consider merges into parents of current branch
+      $cr = $cr->parent if ($cr->is_branch and $rev < $cr->create_rev);
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        next unless /Merged into \S+: (\S+) cf\. (\S+)/;
+
+        # Upper $1 and lower $2 ends of the source delta
+        my $u_path = $1;
+        my $l_path = $2;
+
+        # Add the root directory to the paths if necessary
+        $u_path = '/' . $u_path if substr ($u_path, 0, 1) ne '/';
+        $l_path = '/' . $l_path if substr ($l_path, 0, 1) ne '/';
+
+        # Only consider merges with specified branch (and its parent)
+        (my $path = $u_path) =~ s/@(\d+)$//;
+        my $u_rev = $1;
+
+        my $br = $branch;
+        $br    = $br->parent while (
+          $br->is_branch and $u_rev < $br->create_rev and not $stop_on_copy
+        );
+
+        next unless $br->branch_path eq $path;
+
+        # If $br is a parent of branch, ignore those merges with the parent
+        # above the branch point of the current branch
+        next if $br->pegrev and $br->pegrev < $u_rev;
+
+        # Set the return values
+        $self->{LAST_MERGE}{$branch->url_peg} = [
+          Fcm::CmBranch->new (URL => $cr->url . '@' . $rev), # target
+          Fcm::CmBranch->new (URL => $self->root . $u_path), # delta upper
+          Fcm::CmBranch->new (URL => $self->root . $l_path), # delta lower
+        ];
+
+        last REV;
+      }
+    }
+  }
+
+  return (exists $self->{LAST_MERGE}{$branch->url_peg}
+          ? @{ $self->{LAST_MERGE}{$branch->url_peg} } : ());
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @revs = $cm_branch->avail_merge_from ($branch[, $stop_on_copy]);
+#
+# DESCRIPTION
+#   This method returns a list of revisions of a specified $branch, which are
+#   available for merging into the current branch. If $stop_on_copy is
+#   specified, it will not list available merges from the parents of $branch.
+# ------------------------------------------------------------------------------
+
+sub avail_merge_from {
+  my ($self, $branch, $stop_on_copy) = @_;
+
+  if (not exists $self->{AVAIL_MERGE}{$branch->url_peg}) {
+    # Find out the revision of the upper delta at the last merge from $branch
+    # If no merge is found, use revision of common ancestor with $branch
+    my @last_merge = $self->last_merge_from ($branch);
+    my $rev        = $self->ancestor ($branch)->pegrev;
+    $rev           = $last_merge [1]->pegrev
+      if @last_merge and $last_merge [1]->pegrev > $rev;
+
+    # Get the "log" of the $branch down to $rev
+    my %log = $branch->svnlog (
+      REV          => [($branch->pegrev ? $branch->pegrev : 'HEAD'), $rev],
+      STOP_ON_COPY => $stop_on_copy,
+    );
+
+    # No need to include $rev itself, as it has already been merged
+    delete $log{$rev};
+
+    # No need to include the branch create revision
+    delete $log{$branch->create_rev}
+      if $branch->is_branch and exists $log{$branch->create_rev};
+
+    if (keys %log) {
+      # Check whether there is a latest merge from $self into $branch, if so,
+      # all revisions of $branch below that merge should become unavailable
+      my @last_merge_into = $branch->last_merge_from ($self);
+
+      if (@last_merge_into) {
+        for my $rev (keys %log) {
+          delete $log{$rev} if $rev < $last_merge_into [0]->pegrev;
+        }
+      }
+    }
+
+    # Available merges include all revisions above the branch creation revision
+    # or the revision of the last merge
+    $self->{AVAIL_MERGE}{$branch->url_peg} = [sort {$b <=> $a} keys %log];
+  }
+
+  return @{ $self->{AVAIL_MERGE}{$branch->url_peg} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $lower = $cm_branch->base_of_merge_from ($branch);
+#
+# DESCRIPTION
+#   This method returns the lower delta (a Fcm::CmBranch object) for the next
+#   merge from $branch.
+# ------------------------------------------------------------------------------
+
+sub base_of_merge_from {
+  my ($self, $branch) = @_;
+
+  # Base is the ancestor if there is no merge between $self and $branch
+  my $return = $self->ancestor ($branch);
+
+  # Get configuration for the last merge from $branch to $self
+  my @merge_from = $self->last_merge_from ($branch);
+
+  # Use the upper delta of the last merge from $branch, as all revisions below
+  # that have already been merged into the $self
+  $return = $merge_from [1]
+    if @merge_from and $merge_from [1]->pegrev > $return->pegrev;
+
+  # Get configuration for the last merge from $self to $branch
+  my @merge_into = $branch->last_merge_from ($self);
+
+  # Use the upper delta of the last merge from $self, as the current revision
+  # of $branch already contains changes of $self up to the peg revision of the
+  # upper delta
+  $return = $merge_into [1]
+    if @merge_into and $merge_into [0]->pegrev > $return->pegrev;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_branch->allow_subdir_merge_from ($branch, $subdir);
+#
+# DESCRIPTION
+#   This method returns true if a merge from the sub-directory $subdir in
+#   $branch  is allowed - i.e. it does not result in losing changes made in
+#   $branch outside of $subdir.
+# ------------------------------------------------------------------------------
+
+sub allow_subdir_merge_from {
+  my ($self, $branch, $subdir) = @_;
+
+  # Get revision at last merge from $branch or ancestor
+  my @merge_from = $self->last_merge_from ($branch);
+  my $last       = @merge_from ? $merge_from [1] : $self->ancestor ($branch);
+  my $rev        = $last->pegrev;
+
+  my $return = 1;
+  if ($branch->pegrev > $rev) {
+    # Use "svn diff --summarize" to work out what's changed between last
+    # merge/ancestor and current revision
+    my $range = $branch->pegrev . ':' . $rev;
+    my @out = &run_command (
+      [qw/svn diff --summarize -r/, $range, $branch->url_peg], METHOD => 'qx', 
+    );
+
+    # Returns false if there are changes outside of $subdir
+    my $url = join ('/', $branch->url, $subdir);
+    for my $line (@out) {
+      chomp $line;
+      $line = substr ($line, 7); # file name begins at column 7
+      if ($line !~ m#^$url(?:/|$)#) {
+        $return = 0;
+        last;
+      }
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->create (
+#     SRC                  => $src,
+#     TYPE                 => $type,
+#     NAME                 => $name,
+#     [PASSWORD            => $password,]
+#     [REV_FLAG            => $rev_flag,]
+#     [TICKET              => \@tickets,]
+#     [REV                 => $rev,]
+#     [NON_INTERACTIVE     => 1,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method creates a branch in a Subversion repository.
+#
+# OPTIONS
+#   SRC                 - reference to a Fcm::CmUrl object.
+#   TYPE                - Specify the branch type. See help in "fcm branch" for
+#                         further information.
+#   NAME                - specify the name of the branch.
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   REV                 - specify the operative revision of the source.
+#   REV_FLAG            - A flag to specify the behaviour of the prefix to the
+#                         branch name. See help in "fcm branch" for further
+#                         information.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+#   TICKET              - Specify one or more related tickets for the branch.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  # Compulsory options
+  my $src  = $args{SRC};
+  my $type = $args{TYPE};
+  my $name = $args{NAME};
+
+  # Other options
+  my $rev_flag        = $args{REV_FLAG}        ? $args{REV_FLAG}    : 'NORMAL';
+  my @tickets         = exists $args{TICKET}   ? @{ $args{TICKET} } : ();
+  my $password        = exists $args{PASSWORD} ? $args{PASSWORD}    : undef;
+  my $orev            = exists $args{REV}      ? $args{REV}         : 'HEAD';
+
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Analyse the source URL
+  # ----------------------------------------------------------------------------
+  # Create branch from the trunk by default
+  $src->branch ('trunk') if not $src->branch;
+
+  # Remove "sub-directory" part from source URL
+  $src->subdir ('')      if $src->subdir;
+
+  # Remove "peg revision" part because it does not work with "svn copy"
+  $src->pegrev ('')      if $src->pegrev;
+
+  # Find out the URL and the last changed revision of the specified URL at the
+  # specified operative revision
+  my $url = $src->svninfo (FLAG => 'URL', REV => $orev);
+  e_report $src->url, ': cannot determine the operative URL at revision ',
+           $orev, ', abort.' if not $url;
+
+  $src->url ($url) if $url ne $src->url;
+
+  my $rev = $src->svninfo (FLAG => 'Last Changed Rev', REV => $orev);
+  e_report $src->url, ': cannot determine the last changed rev at revision',
+           $orev, ', abort.' if not $rev;
+
+  # Warn user if last changed revision is not the specified revision
+  w_report 'Warning: branch will be created from revision ', $rev,
+           ', i.e. the last changed rev.'
+    unless $orev and $orev eq $rev;
+
+  # Determine the sub-directory names of the branch
+  # ----------------------------------------------------------------------------
+  my @branch_dirs = ('branches');
+
+  # Split branch type flags into a hash table
+  my %type_flags = ();
+  $type_flags{$_} = 1 for ((split /$Fcm::Config::DELIMITER/, $type));
+
+  # Branch sub-directory 1, development, test or package
+  for my $flag (qw/DEV TEST PKG/) {
+    if (exists $type_flags{$flag}) {
+      push @branch_dirs, lc ($flag);
+      last;
+    }
+  }
+
+  # Branch sub-directory 2, user, share, configuration or release
+  if (exists $type_flags{USER}) {
+    die 'Unable to determine your user ID, abort' unless $self->config->user_id;
+
+    push @branch_dirs, $self->config->user_id;
+
+  } else {
+    for my $flag (keys %Fcm::CmUrl::owner_keywords) {
+      if (exists $type_flags{uc ($flag)}) {
+        push @branch_dirs, $flag;
+        last;
+      }
+    }
+  }
+
+  # Branch sub-directory 3, branch name
+  # Prefix branch name with revision number/keyword if necessary
+  my $prefix = '';
+  if ($rev_flag ne 'NONE') {
+    $prefix = $rev;
+
+    # Attempt to replace revision number with a revision keyword if necessary
+    if ($rev_flag eq 'NORMAL') {
+      $prefix = (Fcm::Keyword::unexpand($src->url_peg(), $rev))[1];
+    }
+
+    # $prefix is still a revision number, add "r" in front of it
+    $prefix = 'r' . $prefix if $prefix eq $rev;
+
+    # Add an underscore before the branch name
+    $prefix.= '_';
+  }
+
+  # Branch name
+  push @branch_dirs, $prefix . $name;
+
+  # Check whether the branch already exists, fail if so
+  # ----------------------------------------------------------------------------
+  # Construct the URL of the branch
+  $self->project_url ($src->project_url);
+  $self->branch  (join ('/', @branch_dirs));
+
+  # Check that branch does not already exists
+  e_report $self->url, ': branch already exists, abort.' if $self->url_exists;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Created ' . $self->branch_path .  ' from ' .
+                 $src->branch_path . '@' . $rev . '.' . "\n");
+
+  # Add related Trac ticket links to commit log if set
+  if (@tickets) {
+    my $ticket_mesg = 'Relates to ticket' . (@tickets > 1 ? 's' : '');
+
+    while (my $ticket = shift @tickets) {
+      $ticket_mesg .= ' #' . $ticket;
+      $ticket_mesg .= (@tickets > 1 ? ',' : ' and') if @tickets >= 1;
+    }
+
+    push @message, $ticket_mesg . ".\n";
+  }
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (\@message);
+  $ci_mesg->ignore_mesg (['A' . ' ' x 4 . $self->url . "\n"]);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $reply = Fcm::Interactive::get_input(
+      title   => 'fcm branch',
+      message => 'Would you like to go ahead and create this branch?',
+      type    => 'yn',
+      default => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Ensure existence of container sub-directories of the branch
+  # ----------------------------------------------------------------------------
+  for my $i (0 .. $#branch_dirs - 1) {
+    my $subdir     = join ('/', @branch_dirs[0 .. $i]);
+    my $subdir_url = Fcm::CmUrl->new (URL => $src->project_url . '/' . $subdir);
+
+    # Check whether each sub-directory of the branch already exists,
+    # if sub-directory does not exist, create it
+    next if $subdir_url->url_exists;
+
+    print 'Creating sub-directory: ', $subdir, "\n";
+
+    my @command = (
+      qw/svn mkdir/,
+      '-m', 'Created ' . $subdir . ' directory.',
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $subdir_url->url,
+    );
+    &run_command (\@command);
+  }
+
+  # Create the branch
+  # ----------------------------------------------------------------------------
+  {
+    print 'Creating branch ', $self->url, ' ...', "\n";
+    my @command = (
+      qw/svn copy/,
+      '-r', $rev,
+      '-F', $logfile,
+      ($svn_non_interactive  ? '--non-interactive'       : ()),
+      (defined $password     ? ('--password', $password) : ()),
+
+      $src->url, $self->url,
+    );
+    &run_command (\@command);
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->delete (
+#     [NON_INTERACTIVE     => 1,]
+#     [PASSWORD            => $password,]
+#     [SVN_NON_INTERACTIVE => 1,]
+#   );
+#
+# DESCRIPTION
+#   This method deletes the current branch from the Subversion repository.
+#
+# OPTIONS
+#   NON_INTERACTIVE     - Do no interactive prompting, set SVN_NON_INTERACTIVE
+#                         to true automatically.
+#   PASSWORD            - specify the password for commit access.
+#   SVN_NON_INTERACTIVE - Do no interactive prompting when running svn commit,
+#                         etc. This option is implied by NON_INTERACTIVE.
+# ------------------------------------------------------------------------------
+
+sub del {
+  my $self = shift;
+  my %args = @_;
+
+  # Options
+  # ----------------------------------------------------------------------------
+  my $password            = exists $args{PASSWORD} ? $args{PASSWORD} : undef;
+  my $non_interactive     = exists $args{NON_INTERACTIVE}
+                            ? $args{NON_INTERACTIVE} : 0;
+  my $svn_non_interactive = exists $args{SVN_NON_INTERACTIVE}
+                            ? $args{SVN_NON_INTERACTIVE} : 0;
+  $svn_non_interactive    = $non_interactive ? 1 : $svn_non_interactive;
+
+  # Ensure URL is a branch
+  # ----------------------------------------------------------------------------
+  e_report $self->url_peg, ': not a branch, abort.' if not $self->is_branch;
+
+  # Message for the commit log
+  # ----------------------------------------------------------------------------
+  my @message = ('Deleted ' . $self->branch_path . '.' . "\n");
+
+  # Create a temporary file for the commit log message
+  my $ci_mesg = Fcm::CmCommitMessage->new;
+  $ci_mesg->auto_mesg (\@message);
+  $ci_mesg->ignore_mesg (['D' . ' ' x 4 . $self->url . "\n"]);
+  my $logfile = $ci_mesg->edit_file (TEMP => 1, BATCH => $non_interactive);
+
+  # Check with the user to see if he/she wants to go ahead
+  # ----------------------------------------------------------------------------
+  if (not $non_interactive) {
+    my $mesg = '';
+    my $user = $self->config->user_id;
+
+    if ($user and $self->branch_owner ne $user) {
+      $mesg .= "\n";
+
+      if (exists $Fcm::CmUrl::owner_keywords{$self->branch_owner}) {
+        my $type = $Fcm::CmUrl::owner_keywords{$self->branch_owner};
+        $mesg .= '*** WARNING: YOU ARE DELETING A ' . uc ($type) .
+                 ' BRANCH.';
+
+      } else {
+        $mesg .= '*** WARNING: YOU ARE DELETING A BRANCH NOT OWNED BY YOU.';
+      }
+
+      $mesg .= "\n" .
+               '*** Please ensure that you have the owner\'s permission.' .
+               "\n\n";
+    }
+
+    $mesg   .= 'Would you like to go ahead and delete this branch?';
+
+    my $reply = Fcm::Interactive::get_input (
+      title   => 'fcm branch',
+      message => $mesg,
+      type    => 'yn',
+      default => 'n',
+    );
+
+    return unless $reply eq 'y';
+  }
+
+  # Delete branch if answer is "y" for "yes"
+  # ----------------------------------------------------------------------------
+  print 'Deleting branch ', $self->url, ' ...', "\n";
+  my @command = (
+    qw/svn delete/,
+    '-F', $logfile,
+    (defined $password    ? ('--password', $password) : ()),
+    ($svn_non_interactive ? '--non-interactive'       : ()),
+
+    $self->url,
+  );
+  &run_command (\@command);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_branch->display_info (
+#     [SHOW_CHILDREN => 1],
+#     [SHOW_OTHER    => 1]
+#     [SHOW_SIBLINGS => 1]
+#   );
+#
+# DESCRIPTION
+#   This method displays information of the current branch. If SHOW_CHILDREN is
+#   set, it shows information of all current children branches of the current
+#   branch. If SHOW_SIBLINGS is set, it shows information of siblings that have
+#   been merged recently with the current branch. If SHOW_OTHER is set, it shows
+#   information of custom/reverse merges.
+# ------------------------------------------------------------------------------
+
+sub display_info {
+  my $self = shift;
+  my %args = @_;
+
+  # Arguments
+  # ----------------------------------------------------------------------------
+  my $show_children = exists $args{SHOW_CHILDREN} ? $args{SHOW_CHILDREN} : 0;
+  my $show_other    = exists $args{SHOW_OTHER   } ? $args{SHOW_OTHER}    : 0;
+  my $show_siblings = exists $args{SHOW_SIBLINGS} ? $args{SHOW_SIBLINGS} : 0;
+
+  # Useful variables
+  # ----------------------------------------------------------------------------
+  my $separator  = '-' x 80 . "\n";
+  my $separator2 = '  ' . '-' x 78 . "\n";
+
+  # Print "info" as returned by "svn info"
+  # ----------------------------------------------------------------------------
+  for my $key ('URL', 'Repository Root', 'Revision', 'Last Changed Author',
+               'Last Changed Rev', 'Last Changed Date') {
+    print $key, ': ', $self->svninfo (FLAG => $key), "\n"
+      if $self->svninfo (FLAG => $key);
+  }
+
+  if ($self->config->verbose) {
+    # Verbose mode, print log message at last changed revision
+    my %log = $self->svnlog (REV => $self->svninfo (FLAG => 'Last Changed Rev'));
+    my @log = split /\n/, $log{msg};
+    print 'Last Changed Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+  }
+
+  if ($self->is_branch) {
+    # Print create information
+    # --------------------------------------------------------------------------
+    my %log = $self->svnlog (REV => $self->create_rev);
+
+    print $separator;
+    print 'Branch Create Author: ', $log{author}, "\n" if $log{author};
+    print 'Branch Create Rev: ', $self->create_rev, "\n";
+    print 'Branch Create Date: ', &svn_date ($log{date}), "\n";
+
+    if ($self->config->verbose) {
+      # Verbose mode, print log message at last create revision
+      my @log = split /\n/, $log{msg};
+      print 'Branch Create Log:', "\n\n", map ({'  ' . $_ . "\n"} @log), "\n";
+    }
+
+    # Print delete information if branch no longer exists
+    # --------------------------------------------------------------------------
+    print 'Branch Delete Rev: ', $self->delete_rev, "\n" if $self->delete_rev;
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    # Print the URL@REV of the parent branch
+    print $separator, 'Branch Parent: ', $self->parent->url_peg, "\n";
+
+    # Set up a new object for the parent at the current revision
+    # --------------------------------------------------------------------------
+    my $p_url  = $self->parent->url;
+    $p_url    .= '@' . $self->pegrev if $self->pegrev;
+    my $parent = Fcm::CmBranch->new (URL => $p_url);
+
+    if (not $parent->url_exists) {
+      print 'Branch parent deleted.', "\n";
+      return;
+    }
+
+    # Report merges into/from the parent
+    # --------------------------------------------------------------------------
+    print $self->_report_merges ($parent, 'Parent');
+  }
+
+  # Report merges with siblings
+  # ----------------------------------------------------------------------------
+  if ($show_siblings) {
+    # Report number of sibling branches found
+    print $separator, 'Searching for siblings ... ';
+    my @siblings = $self->siblings;
+    print scalar (@siblings), ' ', (@siblings> 1 ? 'siblings' : 'sibling'),
+          ' found.', "\n";
+
+    # Report branch name and merge information only if there are recent merges
+    my $out = '';
+    for my $sibling (@siblings) {
+      my $string = $self->_report_merges ($sibling, 'Sibling');
+
+      $out .= $separator2 . '  ' . $sibling->url . "\n" . $string if $string;
+    }
+
+    if (@siblings) {
+      if ($out) {
+        print 'Merges with existing siblings:', "\n", $out;
+
+      } else {
+        print 'No merges with existing siblings.', "\n";
+      }
+    }
+  }
+
+  # Report children
+  # ----------------------------------------------------------------------------
+  if ($show_children) {
+    # Report number of child branches found
+    print $separator, 'Searching for children ... ';
+    my @children = $self->children;
+    print scalar (@children), ' ', (@children > 1 ? 'children' : 'child'),
+          ' found.', "\n";
+
+    # Report children if they exist
+    print 'Current children:', "\n" if @children;
+
+    for my $child (@children) {
+      print $separator2, '  ', $child->url, "\n";
+      print '  Child Create Rev: ', $child->create_rev, "\n";
+      print $self->_report_merges ($child, 'Child');
+    }
+  }
+
+  # Report custom/reverse merges into the branch
+  # ----------------------------------------------------------------------------
+  if ($show_other) {
+    my %log = $self->svnlog (STOP_ON_COPY => 1);
+    my @out;
+
+    # Go down the revision log, checking for merge template messages
+    REV: for my $rev (sort {$b <=> $a} keys %log) {
+      # Loop each line of the log message at each revision
+      my @msg = split /\n/, $log{$rev}{msg};
+
+      for (@msg) {
+        # Ignore unless log message matches a merge template
+        if (/^Reversed r\d+(:\d+)? of \S+$/ or
+            s/^(Custom merge) into \S+(:.+)$/$1$2/) {
+          push @out, ('r' . $rev . ': ' . $_) . "\n";
+        }
+      }
+    }
+
+    print $separator, 'Other merges:', "\n", @out if @out;
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $self->_report_merges ($branch, $relation);
+#
+# DESCRIPTION
+#   This method returns a string for displaying merge information with a
+#   branch, the $relation of which can be a Parent, a Sibling or a Child.
+# ------------------------------------------------------------------------------
+
+sub _report_merges {
+  my ($self, $branch, $relation) = @_;
+
+  my $indent    = ($relation eq 'Parent') ? '' : '  ';
+  my $separator = ($relation eq 'Parent') ? ('-' x 80) : ('  ' . '-' x 78);
+  $separator   .= "\n";
+
+  my $return = '';
+
+  # Report last merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %merge  = (
+    'Last Merge From ' . $relation . ':'
+    => [$self->last_merge_from ($branch, 1)],
+    'Last Merge Into ' . $relation . ':'
+    => [$branch->last_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of the merge
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      my $t = ($key =~ /From/) ? $self : $branch;
+
+      $return .= $indent . $key . "\n";
+      $return .= $separator . $t->display_svnlog ($merge{$key}[0]->pegrev);
+    }
+
+  } else {
+    # Normal mode, print in simplified form (rREV Parent@REV)
+    for my $key (keys %merge) {
+      next if not @{ $merge{$key} };
+
+      # From: target (0) is self, upper delta (1) is $branch
+      # Into: target (0) is $branch, upper delta (1) is self
+      $return .= $indent . $key . ' r' . $merge{$key}[0]->pegrev . ' ' .
+                 $merge{$key}[1]->path_peg . ' cf. ' .
+                 $merge{$key}[2]->path_peg . "\n";
+    }
+  }
+
+  if ($relation eq 'Sibling') {
+    # For sibling, do not report further if there is no recent merge
+    my @values = values %merge;
+
+    return $return unless (@{ $values[0] } or @{ $values[1] });
+  }
+
+  # Report available merges into/from the $branch
+  # ----------------------------------------------------------------------------
+  my %avail = (
+    'Merges Avail From ' . $relation . ':'
+    => ($self->delete_rev ? [] : [$self->avail_merge_from ($branch, 1)]),
+    'Merges Avail Into ' . $relation . ':'
+    => [$branch->avail_merge_from ($self, 1)],
+  );
+
+  if ($self->config->verbose) {
+    # Verbose mode, print the log of each revision
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . "\n";
+
+      my $s = ($key =~ /From/) ? $branch: $self;
+
+      for my $rev (@{ $avail{$key} }) {
+        $return .= $separator . $s->display_svnlog ($rev);
+      }
+    }
+
+  } else {
+    # Normal mode, print only the revisions
+    for my $key (keys %avail) {
+      next unless @{ $avail{$key} };
+
+      $return .= $indent . $key . ' ' . join (' ', @{ $avail{$key} }) . "\n";
+    }
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/CmCommitMessage.pm
===================================================================
--- vendors/FCM/lib/Fcm/CmCommitMessage.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CmCommitMessage.pm	(revision 9621)
@@ -0,0 +1,319 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmCommitMessage
+#
+# DESCRIPTION
+#   This class contains methods to read, write and edit the commit message file
+#   in a working copy.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmCommitMessage;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Spec;
+use File::Temp qw/tempfile/;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::Util qw/e_report run_command/;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'auto_mesg',   # the automatically inserted part of a commit message
+  'base',        # the base name of the commit message file
+  'dir',         # the directory container of the commit message file
+  'ignore_mesg', # the ignored part of a commit message
+  'user_mesg',   # the user defined part of a commit message
+);
+
+# Commit log delimiter messages
+my $log_delimiter        = '--Add your commit message ABOVE - ' .
+                           'do not alter this line or those below--';
+my $auto_delimiter       = '--FCM message (will be inserted automatically)--';
+my $auto_delimiter_old   = '--This line will be ignored and those below ' .
+                           'will be inserted automatically--';
+my $status_delimiter     = '--Change summary ' .
+                           '(not part of commit message)--';
+my $status_delimiter_old = '--This line, and those below, will be ignored--';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::CmCommitMessage->new ();
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmCommitMessage class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'base') {
+        # Reference to an array
+        $self->{$name} = '#commit_message#';
+
+      } elsif ($name eq 'dir') {
+        # Current working directory
+        $self->{$name} = &cwd ();
+
+      } elsif ($name =~ /_mesg$/) {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $obj->file;
+#   $obj->file ($file);
+#
+# DESCRIPTION
+#   This method returns the full name of the commit message file. If an
+#   argument is specified, the file is reset using the value of the argument.
+# ------------------------------------------------------------------------------
+
+sub file {
+  my ($self, $file) = @_;
+
+  if ($file) {
+    $self->dir  (dirname  ($file));
+    $self->base (basename ($file));
+  }
+
+  return File::Spec->catfile ($self->dir, $self->base);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($user, $auto) = $obj->read_file ();
+#
+# DESCRIPTION
+#   This function reads from the commit log message file. It resets the user
+#   and the automatic messages after reading the file. It returns the message
+#   back in two array references.
+# ------------------------------------------------------------------------------
+
+sub read_file {
+  my $self = shift;
+
+  my @user = ();
+  my @auto = ();
+  my $file = $self->file;
+
+  if (-r $file) {
+    open FILE, '<', $file or croak 'Cannot open ', $file, '(', $!, '), abort';
+
+    my $in_auto = 0;
+    while (<FILE>) {
+
+      next if (index ($_, $log_delimiter) == 0); 
+
+      if (index ($_, $status_delimiter)     == 0 ||
+          index ($_, $status_delimiter_old) == 0) {
+        # Ignore after the ignore delimiter
+        last;
+      }
+
+      if (index ($_, $auto_delimiter)     == 0 ||
+          index ($_, $auto_delimiter_old) == 0) {
+        # Beginning of the automatically inserted message
+        $in_auto = 1;
+        next;
+      }
+
+      if ($in_auto) {
+        push @auto, $_;
+
+      } else {
+        push @user, $_;
+      }
+    }
+
+    close FILE;
+
+    $self->user_mesg (\@user);
+    $self->auto_mesg (\@auto);
+  }
+
+  return (\@user, \@auto);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->write_file ();
+#
+# DESCRIPTION
+#   This function writes to the commit log message file based on the content of
+#   the user defined message, and the automatically inserted message.
+# ------------------------------------------------------------------------------
+
+sub write_file {
+  my $self = shift;
+  my %args = @_;
+
+  my @user = @{ $self->user_mesg };
+  my @auto = @{ $self->auto_mesg };
+  my $file = $self->file;
+
+  open FILE, '>', $file or die 'Cannot open ', $file, '(', $!, '), abort';
+  print FILE @user;
+  print FILE $log_delimiter, "\n", $auto_delimiter, "\n", @auto if @auto;
+  close FILE or croak 'Cannot close ', $file, '(', $!, '), abort';
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $file = $obj->edit_file ([TEMP => 1,] [BATCH => 1,]);
+#
+# DESCRIPTION
+#   This function normally triggers an editor for editing the commit message.
+#   If TEMP is set, it edits a temporary file. Otherwise, it edits the current
+#   commit message file. It resets the user defined message on success. Returns
+#   the name of the commit log file. Do not start the editor if BATCH is set.
+# ------------------------------------------------------------------------------
+
+sub edit_file {
+  my $self  = shift;
+  my %args  = @_;
+  my $temp  = exists $args{TEMP}  ? $args{TEMP}  : 0;
+  my $batch = exists $args{BATCH} ? $args{BATCH} : 0;
+
+  my @user   = @{ $self->user_mesg };
+  my @auto   = @{ $self->auto_mesg };
+  my @ignore = @{ $self->ignore_mesg };
+  my $file   = $self->file;
+
+  if ($temp) {
+    my $fh;
+    ($fh, $file) = tempfile (SUFFIX => ".fcm", UNLINK => 1);
+    close $fh;
+  }
+
+  # Add original or code driven message and status information to the file
+  my $select = select;
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  select FILE;
+
+  print @user;
+  print (@auto || @user ? '' : "\n");
+  print $log_delimiter, "\n";
+  print $auto_delimiter, "\n", @auto, "\n" if @auto;
+  print $status_delimiter, "\n\n";
+  print @ignore if @ignore;
+
+  close FILE or die 'Cannot close ', $file, ' (', $!, '), abort';
+  select $select;
+
+  if (not $batch) {
+    # Select editor
+    my $editor = 'nedit';
+    
+    if ($ENV{'SVN_EDITOR'}) {
+      $editor = $ENV{'SVN_EDITOR'};
+
+    } elsif ($ENV{'VISUAL'}) {
+      $editor = $ENV{'VISUAL'};
+
+    } elsif ($ENV{'EDITOR'}) {
+      $editor = $ENV{'EDITOR'};
+    }
+
+    # Execute command to start the editor
+    print 'Starting ', $editor, ' to edit commit message ...', "\n";
+    &run_command ([split (/\s+/, $editor), $file]);
+  }
+
+  # Read the edited file, and extract user log message from it
+  open FILE, '<', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  my (@log);
+  my $delimiter_found = 0;
+
+  while (<FILE>) {
+    if (index ($_, $log_delimiter) == 0) {
+      $delimiter_found = 1;
+      last;
+    }
+    push @log, $_;
+  }
+
+  close FILE;
+
+  # Ensure log delimiter line was not altered
+  e_report 'Error: the line "', $log_delimiter, '" has been altered, abort.'
+    if not $delimiter_found;
+
+  # Check for empty commit log
+  e_report 'Error: log message unchanged or not specified, abort.'
+    if join (' ', (@log, @auto)) =~ /^\s*$/;
+
+  # Echo the commit message to standard output
+  my $separator = '-' x 80 . "\n";
+  print 'Change summary:', "\n";
+  print $separator, @ignore, $separator;
+  print 'Commit message is as follows:', "\n";
+  print $separator, @log, @auto, $separator;
+
+  open FILE, '>', $file or croak 'Cannot open ', $file, ' (', $!, '), abort';
+  print FILE @log, @auto;
+  close FILE or croak 'Cannot close ', $file, ' (', $!, '), abort';
+
+  # Reset the array for the user specified log message
+  $self->user_mesg (\@log);
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/CmUrl.pm
===================================================================
--- vendors/FCM/lib/Fcm/CmUrl.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/CmUrl.pm	(revision 9621)
@@ -0,0 +1,1149 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::CmUrl
+#
+# DESCRIPTION
+#   This class contains methods for manipulating a Subversion URL in a standard
+#   FCM project.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::CmUrl;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use HTTP::Date;
+use XML::DOM;
+
+# FCM component modules
+use Fcm::Base;
+use Fcm::Keyword;
+use Fcm::Util qw/run_command svn_date/;
+
+# Special branches
+our %owner_keywords = (Share => 'shared', Config => 'config', Rel => 'release');
+
+# Revision pattern
+my $rev_pattern = '\d+|HEAD|BASE|COMMITTED|PREV|\{.+\}';
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $cm_url = Fcm::CmUrl->new ([URL => $url,]);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::CmUrl class.
+#
+# ARGUMENTS
+#   URL - URL of a branch
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  $self->{URL} = (exists $args{URL} ? $args{URL} : '');
+
+  for (qw/ANALYSED BRANCH BRANCH_LIST INFO LIST LOG LOG_RANGE PEGREV RLIST
+          PROJECT SUBDIR/) {
+    $self->{$_} = undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url_peg;
+#   $cm_url->url_peg ($url);
+#
+# DESCRIPTION
+#   This method returns/sets the current URL@PEG.
+# ------------------------------------------------------------------------------
+
+sub url_peg {
+  my $self = shift;
+
+  if (@_) {
+    if (! $self->{URL} or $_[0] ne $self->{URL}) {
+      # Re-set URL
+      $self->{URL} = shift;
+
+      # Re-set essential variables
+      $self->{$_}  = undef for (qw/ANALYSED RLIST LIST INFO LOG LOG_RANGE/);
+    }
+  }
+
+  return $self->{URL};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_url ();
+#
+# DESCRIPTION
+#   Returns true if current url is a valid Subversion URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  my $self = shift;
+
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($self->url_peg =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->url_exists ([$rev]);
+#
+# DESCRIPTION
+#   Returns true if current url exists (at operative revision $rev) in a
+#   Subversion repository.
+# ------------------------------------------------------------------------------
+
+sub url_exists {
+  my ($self, $rev) = @_;
+
+  my $exists = $self->svnlist (REV => $rev);
+
+  return defined ($exists);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_url->svninfo ([FLAG => $flag], [REV => $rev]);
+#
+# DESCRIPTION
+#   Returns the value of $flag, where $flag is a field returned by "svn info".
+#   (If $flag is not set, default to "URL".) Otherwise returns an empty string.
+#   If REV is specified, it will be used as the operative revision.
+# ------------------------------------------------------------------------------
+
+sub svninfo {
+  my $self = shift;
+  my %args = @_;
+
+  my $flag = exists $args{FLAG} ? $args{FLAG} : 'URL';
+  my $rev  = exists $args{REV}  ? $args{REV}  : undef;
+
+  $rev = ($self->pegrev ? $self->pegrev : 'HEAD') if not $rev;
+
+  return if not $self->is_url;
+
+  # Get "info" for the specified revision if necessary
+  if (not exists $self->{INFO}{$rev}) {
+    # Invoke "svn info" command
+    my @info = &run_command (
+      [qw/svn info -r/, $rev, $self->url_peg],
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+    );
+
+    # Store selected information
+    for (@info) {
+      chomp;
+
+      if (/^(.+?):\s*(.+)$/) {
+        $self->{INFO}{$rev}{$1} = $2;
+      }
+    }
+  }
+
+  my $return = exists $self->{INFO}{$rev}{$flag}
+               ? $self->{INFO}{$rev}{$flag} : undef;
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %logs = $cm_url->svnlog (
+#     [REV          => $rev,]
+#     [REV          => \@revs,] # reference to a 2-element array
+#     [STOP_ON_COPY => 1,]
+#   );
+#
+# DESCRIPTION
+#   Returns the logs for the current URL. If REV is a range of revisions or not
+#   specified, return a hash where the keys are revision numbers and the values
+#   are the entries (which are hash references). If a single REV is specified,
+#   return the entry (a hash reference) at the specified REV. Each entry in the
+#   returned list is a hash reference, with the following structure:
+#
+#   $entry = {
+#     author => $author,              # the commit author
+#     date   => $date,                # the commit date (in seconds since epoch)
+#     msg    => $msg,                 # the log message
+#     paths  => {                     # list of changed paths
+#       $path1  => {                  # a changed path
+#         copyfrom-path => $frompath, # copy-from-path
+#         copyfrom-rev  => $fromrev,  # copy-from-revision
+#         action        => $action,   # action status code
+#       },
+#       ...     => { ... },           # ... more changed paths ...
+#     },
+#   }
+# ------------------------------------------------------------------------------
+
+sub svnlog {
+  my $self = shift;
+  my %args = @_;
+
+  my $stop_on_copy  = exists $args{STOP_ON_COPY} ? $args{STOP_ON_COPY} : 0;
+  my $rev_arg       = exists $args{REV}          ? $args{REV}          : 0;
+
+  my @revs;
+
+  # Get revision options
+  # ----------------------------------------------------------------------------
+  if ($rev_arg) {
+    if (ref ($rev_arg)) {
+      # Revsion option is an array, a range of revisions specified?
+      ($revs [0], $revs [1]) = @$rev_arg;
+
+    } else {
+      # A single revision specified
+      $revs [0] = $rev_arg;
+    }
+
+    # Expand 'HEAD' revision
+    for my $rev (@revs) {
+      next unless uc ($rev) eq 'HEAD';
+      $rev = $self->svninfo (FLAG => 'Revision', REV => 'HEAD');
+    }
+
+  } else {
+    # No revision option specified, get log for all revisions
+    $revs [0] = $self->svninfo (FLAG => 'Revision');
+    $revs [1] = 1;
+  }
+
+  $revs [1] = $revs [0] if not $revs [1];
+  @revs     = sort {$b <=> $a} @revs;
+
+  # Check whether a "svn log" run is necessary
+  # ----------------------------------------------------------------------------
+  my $need_update = ! ($revs [0] == $revs [1] and exists $self->{LOG}{$revs [0]});
+  my @ranges      = @revs;
+  if ($need_update and $self->{LOG_RANGE}) {
+    my %log_range = %{ $self->{LOG_RANGE} };
+
+    if ($stop_on_copy) {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER_SOC};
+
+    } else {
+      $ranges [1] = $log_range{UPPER} if $ranges [1] >= $log_range{LOWER};
+    }
+  }
+
+  $need_update = 0 if $ranges [0] < $ranges [1];
+
+  if ($need_update) {
+    # Invoke "svn log" command for all revisions of the current branch
+    # --------------------------------------------------------------------------
+    my @command = (
+      qw/svn log --xml -v/, ($stop_on_copy ? '--stop-on-copy' : ()),
+      '-r' . join (':', @ranges),
+      $self->url_peg,
+    );
+
+    my $rc;
+    my @xml = &run_command (
+      \@command,
+      PRINT   => $self->config->verbose > 2,
+      METHOD  => 'qx',
+      DEVNULL => 1,
+      ERROR   => 'ignore',
+      RC      => \$rc,
+    );
+
+    # Parse the XML
+    # --------------------------------------------------------------------------
+    if (not $rc) {
+      my $parser = XML::DOM::Parser->new;
+      my $doc    = $parser->parse (join ('', @xml));
+
+      my $entry_list = $doc->getElementsByTagName ('logentry');
+
+      # Record the author, date, message and path change for each revision
+      for my $i (0 .. $entry_list->getLength - 1) {
+        # Select current entry from node list
+        my $entry = $entry_list->item ($i);
+        my %this = ();
+
+        # Revision is an attribute of the entry node
+        my $rev   = $entry->getAttributeNode ('revision')->getValue;
+
+        # Author, date and log message are children elements of the entry node
+        for my $key (qw/author date msg/) {
+          # Get data of each node, also convert date to seconds since epoch
+          my $node    = $entry->getElementsByTagName ($key)->item (0);
+          my $data    = ($node and $node->getFirstChild)
+                        ? $node->getFirstChild->getData : '';
+          $this{$key} = ($key eq 'date' ? str2time ($data) : $data);
+        }
+
+        # Path nodes are grand children elements of the entry node
+        my $paths = $entry->getElementsByTagName ('path');
+
+        for my $p (0 .. $paths->getLength - 1) {
+          # Select current path node from node list
+          my $node = $paths->item ($p);
+
+          # Get data from the path node
+          my $path = $node->getFirstChild->getData;
+          $this{paths}{$path} = {};
+
+          # Action, copyfrom-path and copyfrom-rev are attributes of path nodes
+          for my $key (qw/action copyfrom-path copyfrom-rev/) {
+            next unless $node->getAttributeNode ($key); # ensure attribute exists
+
+            $this{paths}{$path}{$key} = $node->getAttributeNode ($key)->getValue;
+          }
+        }
+
+        $self->{LOG}{$rev} = \%this;
+      }
+    }
+
+    # Update the range cache
+    # --------------------------------------------------------------------------
+    # Upper end of the range
+    $self->{LOG_RANGE}{UPPER} = $ranges [0]
+      if ! $self->{LOG_RANGE}{UPPER} or $ranges [0] > $self->{LOG_RANGE}{UPPER};
+
+    # Lower end of the range, need to take into account the stop-on-copy option
+    if ($stop_on_copy) {
+      # Lower end of the range with stop-on-copy option
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+
+      my $low = (sort {$a <=> $b} keys %{ $self->{LOG} }) [0];
+      $self->{LOG_RANGE}{LOWER} = $low
+        if ! $self->{LOG_RANGE}{LOWER} or $low < $self->{LOG_RANGE}{LOWER};
+
+    } else {
+      # Lower end of the range without the stop-on-copy option
+      $self->{LOG_RANGE}{LOWER} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER};
+
+      $self->{LOG_RANGE}{LOWER_SOC} = $ranges [1]
+        if ! $self->{LOG_RANGE}{LOWER_SOC} or
+           $ranges [1] < $self->{LOG_RANGE}{LOWER_SOC};
+    }
+  }
+
+  my %return = ();
+
+  if (! $rev_arg or ref ($rev_arg)) {
+    # REV is an array, return log entries if they are within range
+    for my $rev (sort {$b <=> $a} keys %{ $self->{LOG} }) {
+      next if $rev > $revs [0] or $revs [1] > $rev;
+
+      $return{$rev} = $self->{LOG}{$rev};
+
+      if ($stop_on_copy) {
+        last if exists $self->{LOG}{$rev}{paths}{$self->branch_path} and
+           $self->{LOG}{$rev}{paths}{$self->branch_path}{action} eq 'A';
+      }
+    }
+
+  } else {
+    # REV is a scalar, return log of the specified revision if it exists
+    %return = %{ $self->{LOG}{$revs [0]} } if exists $self->{LOG}{$revs [0]};
+  }
+
+  return %return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $cm_branch->display_svnlog ($rev, [$wiki]);
+#
+# DESCRIPTION
+#   This method returns a string for displaying the log of the current branch
+#   at a $rev. If $wiki is set, returns a string for displaying in a Trac wiki
+#   table.  The value of $wiki should be the Subversion URL of a FCM project
+#   associated with the intended Trac system.
+# ------------------------------------------------------------------------------
+
+sub display_svnlog {
+  my ($self, $rev, $wiki) = @_;
+  my $return = '';
+
+  my %log = $self->svnlog (REV => $rev);
+
+  if ($wiki) {
+    # Output in Trac wiki format
+    # --------------------------------------------------------------------------
+    $return .= '|| ' . &svn_date ($log{date}) . ' || ' . $log{author} . ' || ';
+
+    my $trac_url = Fcm::Keyword::get_browser_url($self->url);
+
+    # Get list of tickets from log
+    my @tickets;
+    while ($log{msg} =~ /(?:(\w+):)?(?:#|ticket:)(\d+)/g) {
+      push @tickets, [$1, $2];
+    }
+    @tickets = sort {
+      if ($a->[0] and $b->[0]) {
+        $a->[0] cmp $b->[0] or $a->[1] <=> $b->[1];
+
+      } elsif ($a->[0]) {
+        1;
+
+      } else {
+        $a->[1] <=> $b->[1];
+      }
+    } @tickets;
+
+    if ($trac_url =~ m#^$wiki(?:/*|$)#) {
+      # URL is in the specified $wiki, use Trac link
+      $return .= '[' . $rev . '] ||';
+
+      for my $ticket (@tickets) {
+        $return .= ' ';
+        $return .= $ticket->[0] . ':' if $ticket->[0];
+        $return .= '#' . $ticket->[1];
+      }
+
+      $return .= ' ||';
+
+    } else {
+      # URL is not in the specified $wiki, use full URL
+      my $rev_url = $trac_url;
+      $rev_url    =~ s{/intertrac/source:.*\z}{/intertrac/changeset:$rev}xms;
+      $return    .= '[' . $rev_url . ' ' . $rev . '] ||';
+
+      my $ticket_url = $trac_url;
+      $ticket_url    =~ s{/intertrac/source:.*\z}{/intertrac/}xms;
+
+      for my $ticket (@tickets) {
+        $return .= ' [' . $ticket_url;
+        $return .= $ticket->[0] . ':' if $ticket->[0];
+        $return .= 'ticket:' . $ticket->[1] . ' ' . $ticket->[1] . ']';
+      }
+
+      $return .= ' ||';
+    }
+
+  } else {
+    # Output in plain text format
+    # --------------------------------------------------------------------------
+    my @msg  = split /\n/, $log{msg};
+    my $line = (@msg > 1 ? ' lines' : ' line');
+
+    $return .= join (
+      ' | ',
+      ('r' . $rev, $log{author}, &svn_date ($log{date}), scalar (@msg) . $line),
+    );
+    $return .= "\n\n";
+    $return .= $log{msg};
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->svnlist ([REV => $rev], [RECURSIVE => 1]);
+#
+# DESCRIPTION
+#   The method returns a list of paths as returned by "svn list". If RECURSIVE
+#   is set, "svn list" is invoked with the "-R" option.
+# ------------------------------------------------------------------------------
+
+sub svnlist {
+  my $self = shift;
+  my %args = @_;
+
+  my $recursive = exists $args{RECURSIVE} ? $args{RECURSIVE} : 0;
+  my $rev       = exists $args{REV}       ? $args{REV}       : undef;
+  my $key       = $recursive ? 'RLIST' : 'LIST';
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Last Changed Rev', REV => $rev);
+  return () if not $rev;
+
+  # Get directory listing for the current URL at the last changed revision
+  if (not exists $self->{$key}{$rev}) {
+    my $rc;
+
+    my @list = map {chomp; $_} &run_command (
+      [qw/svn list -r/, $rev, ($recursive ? '-R' : ()), $self->url_peg],
+      METHOD => 'qx', ERROR => 'ignore', DEVNULL => 1, RC => \$rc,
+    );
+
+    $self->{$key}{$rev} = $rc ? undef : \@list;
+  }
+
+  return (defined ($self->{$key}{$rev}) ? @{ $self->{$key}{$rev} } : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @list = $cm_url->branch_list ($rev);
+#
+# DESCRIPTION
+#   The method returns a list of branches in the current project, assuming the
+#   FCM naming convention. If $rev if specified, it returns the list of
+#   branches at $rev.
+# ------------------------------------------------------------------------------
+
+sub branch_list {
+  my ($self, $rev) = @_;
+
+  # Current URL must be a valid FCM project
+  return if not $self->project;
+
+  # Find out last changed revision of the current URL
+  $rev = $self->svninfo (FLAG => 'Revision', REV => $rev);
+  return () if not $rev;
+
+  if (not exists $self->{BRANCH_LIST}{$rev}) {
+    $self->{BRANCH_LIST}{$rev} = [];
+
+    # Get URL of the project "branches/" sub-directory
+    my $url = Fcm::CmUrl->new (URL => $self->project_url . '/branches');
+
+    # List three levels underneath "branches/"
+    # First level, i.e. dev, test, pkg, etc
+    my @list1 = map {$url->url . '/' . $_} $url->svnlist (REV => $rev);
+    @list1    = grep m#/$#, @list1;
+
+    # Second level, i.e. user name, Shared, Rel or Config
+    my @list2;
+    for (@list1) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = $u->svnlist (REV => $rev);
+
+      push @list2, map {$u->url . $_} @list;
+    }
+
+    # Third level, branch name
+    for (@list2) {
+      my $u    = Fcm::CmUrl->new (URL => $_);
+      my @list = map {s#/*$##; $_} $u->svnlist (REV => $rev);
+
+      push @{ $self->{BRANCH_LIST}{$rev} }, map {$u->url . $_} @list;
+    }
+  }
+
+  return @{ $self->{BRANCH_LIST}{$rev} };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->_analyse_url ();
+#
+# DESCRIPTION
+#   The method analyses the current URL, breaking it up into the project
+#   (substring of URL up to the slash before "trunk", "branches" or "tags"),
+#   branch name ("trunk", "branches/<type>/<id>/<name>" or "tags/<name>") and
+#   the sub-directory below the top of the project sub-tree. It re-sets the
+#   corresponding interal variables.
+# ------------------------------------------------------------------------------
+
+sub _analyse_url {
+  my $self = shift;
+  my ($url, $project, $branch, $subdir, $pegrev);
+
+  # Check that URL is set
+  $url    = $self->url_peg;
+  return if not $url;
+  return if not $self->is_url;
+
+  # Extract from URL the peg revision
+  $pegrev = $1 if $url =~ s/@($rev_pattern)$//i;
+
+  if ($url =~ m#^(.*?)/+(trunk|branches|tags)(?:/+(.*))?/*$#) {
+    # URL is under the "trunk", a branch or a tag
+    $project                 = $1;
+    my ($branch_id, $remain) = ($2, $3);
+
+    $remain = '' if not defined $remain;
+
+    if ($branch_id eq 'trunk') {
+      # URL under the "trunk"
+      $branch = 'trunk';
+
+    } else {
+      # URL under a branch or a tag
+      $branch = $branch_id;
+
+      # Assume "3 sub-directories", FCM branch naming convention
+      for (1 .. 3) {
+        if ($remain =~ s#^([^/]+)(?:/+|$)##) {
+          $branch .=  '/' . $1;
+
+        } else {
+          $branch = undef;
+          last;
+        }
+      }
+    }
+
+    $subdir = $remain ? $remain : '' if $branch;
+
+  } else {
+    # URL is at some level above the "trunk", a branch or a tag
+    # Use "svn ls" to determine whether it is a project URL
+    my @list = $self->svnlist (REV => ($pegrev ? $pegrev : 'HEAD'));
+    my %lines = map {chomp $_; ($_, 1)} @list;
+
+    # A project URL should have the "trunk", "branches" and "tags" directories
+    ($project = $url) =~ s#/*$##
+      if $lines{'trunk/'} and $lines{'branches/'} and $lines{'tags/'};
+  }
+
+  $self->{PROJECT}  = $project;
+  $self->{BRANCH}   = $branch;
+  $self->{SUBDIR}   = $subdir;
+  $self->{PEGREV}   = $pegrev;
+  $self->{ANALYSED} = 1;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->root ();
+#
+# DESCRIPTION
+#   The method returns the repository root of the current URL.
+# ------------------------------------------------------------------------------
+
+sub root {
+  my $self = shift;
+
+  return $self->svninfo (FLAG => 'Repository Root');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url_peg ();
+#   $cm_url->project_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "project" part of the current URL. If
+#   an argument is specified, the URL of the "project" part and the peg
+#   revision of the current URL are re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url_peg or $url ne $self->project_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT} . ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->project_url ();
+#   $cm_url->project_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "project" part of the current URL. If an
+#   argument is specified, the URL of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->project_url or $url ne $self->project_url) {
+      $url .= '/' . $self->branch if $self->branch;
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PROJECT};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->project_path ();
+#   $cm_url->project_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "project" part of the current URL. If an
+#   argument is specified, the path of the "project" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub project_path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project_path or $path ne $self->project_path) {
+      $path .= '/' . $self->branch if $self->branch;
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->{PROJECT}, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $cm_url->project ();
+#   $cm_url->project ($name);
+#
+# DESCRIPTION
+#   The method returns the basename of the "project" part of the current URL.
+#   If an argument is specified, the basename of the "project" part of the
+#   current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub project {
+  my $self = shift;
+
+  if (@_) {
+    my $name = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->project or $name ne $self->project) {
+      my $url = '';
+      if ($self->project) {
+        $url =  $self->project;
+        $url =~ s#/[^/]+$##;
+
+      } else {
+        $url =  $self->root;
+      }
+
+      $url .=  '/' . $name;
+      $url .=  '/' . $self->branch if $self->branch;
+      $url .=  '/' . $self->subdir if $self->subdir;
+      $url .=  '@' . $self->pegrev if $self->pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  my $name = $self->{PROJECT};
+  $name =~ s#^.*/([^/]+)$#$1# if $name;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url_peg ();
+#   $cm_url->branch_url_peg ($url);
+#
+# DESCRIPTION
+#   The method returns the URL@PEG of the "branch" part of the current URL. If
+#   an argument is specified, the URL@PEG of the "branch" part of the current
+#   URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url_peg {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url_peg or $url ne $self->branch_url_peg) {
+      my $pegrev = ($url =~ s/@($rev_pattern)$//i) ? $1 : '';
+
+      $url .= '/' . $self->subdir if $self->subdir;
+      $url .= '@' . $pegrev       if $pegrev;
+
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch .
+         ($self->pegrev ? '@' . $self->pegrev : '');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->branch_url ();
+#   $cm_url->branch_url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL of the "branch" part of the current URL. If an
+#   argument is specified, the URL of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_url or $url ne $self->branch_url) {
+      $url .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->project_url . '/' . $self->branch;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->branch_path ();
+#   $cm_url->branch_path ($path);
+#
+# DESCRIPTION
+#   The method returns the path of the "branch" part of the current URL. If an
+#   argument is specified, the path of the "branch" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub branch_path {
+  my $self = shift;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch_path or $path ne $self->branch_path) {
+      $path .= '/' . $self->subdir if $self->subdir;
+
+      $self->path ($path);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch ? $self->project_path . '/' . $self->branch : undef);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $branch = $cm_url->branch ();
+#   $cm_url->branch ($branch);
+#
+# DESCRIPTION
+#   The method returns the "branch" part of the current URL. If an argument is
+#   specified, the "branch" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub branch {
+  my $self = shift;
+
+  if (@_) {
+    my $branch = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->branch or $branch ne $self->branch) {
+      my $url = $self->project_url;
+      $url   .= '/' . $branch;
+      $url   .= '/' . $self->subdir if $self->subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{BRANCH};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->branch_owner;
+#
+# DESCRIPTION
+#   This method returns the owner of the branch.
+# ------------------------------------------------------------------------------
+
+sub branch_owner {
+  my $self = shift;
+  my $return;
+
+  if ($self->is_branch and $self->branch_url =~ m#/([^/]+)/[^/]+/*$#) {
+    my $user = $1;
+    $return = $user;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_trunk ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) the trunk.
+# ------------------------------------------------------------------------------
+
+sub is_trunk {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch eq 'trunk');
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_branch ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a branch.
+# ------------------------------------------------------------------------------
+
+sub is_branch {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^branches/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $cm_url->is_tag ();
+#
+# DESCRIPTION
+#   The method returns true if the the current URL is (a sub-tree of) a tag.
+# ------------------------------------------------------------------------------
+
+sub is_tag {
+  my $self = shift;
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return ($self->branch and $self->branch =~ m#^tags/#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $subdir = $cm_url->subdir ();
+#   $cm_url->subdir ($subdir);
+#
+# DESCRIPTION
+#   The method returns the "subdir" part of the current URL. If an argument is
+#   specified, the "subdir" part of the current URL is re-set.
+# ------------------------------------------------------------------------------
+
+sub subdir {
+  my $self = shift;
+
+  if (@_) {
+    my $subdir = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->subdir or $subdir ne $self->subdir) {
+      my $url = $self->project_url;
+      $url   .= '/' . $self->branch if $self->branch;
+      $url   .= '/' . $subdir if $subdir;
+
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{SUBDIR};
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = $cm_url->url ();
+#   $cm_url->url ($url);
+#
+# DESCRIPTION
+#   The method returns the URL without the "peg revision" part. If an argument
+#   is specified, the URL is re-set without modifying the "peg revision" part.
+# ------------------------------------------------------------------------------
+
+sub url {
+  my $self = shift;
+
+  if (@_) {
+    my $url = shift;
+    $url    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL if necessary
+    if (! $self->url or $url ne $self->url) {
+      $self->url_peg ($url . ($self->pegrev ? '@' . $self->pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  (my $url = $self->url_peg) =~ s/@($rev_pattern)$//i;
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path ();
+#   $cm_url->path ($path);
+#
+# DESCRIPTION
+#   The method returns the "path" part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the "path" part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+    $path    =~ s/@($rev_pattern)$//i;
+
+    # Re-construct URL is necessary
+    if (! $self->path or $path ne $self->path) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $path = $cm_url->path_peg ();
+#   $cm_url->path_peg ($path);
+#
+# DESCRIPTION
+#   The method returns the PATH@PEG part of the URL (i.e. URL without the
+#   "root" part). If an argument is specified, the PATH@PEG part of the URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub path_peg {
+  my $self = shift;
+
+  # Repository root
+  my $root = $self->root;
+  $root    = substr (
+    $self->project_url,
+    0,
+    length ($self->project_url) - length ($self->project) - 1
+  ) if not $root;
+
+  if (@_) {
+    my $path = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->path_peg or $path ne $self->path_peg) {
+      my $url = ($root . (substr ($path, 0, 1) eq '/' ? '' : '/') . $path);
+      $self->url_peg ($url);
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return substr ($self->url_peg, length ($root));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $cm_url->pegrev ();
+#   $cm_url->pegrev ($rev);
+#
+# DESCRIPTION
+#   The method returns the "peg revision" part of the current URL. If an
+#   argument is specified, the "peg revision" part of the current URL is
+#   re-set.
+# ------------------------------------------------------------------------------
+
+sub pegrev {
+  my $self = shift;
+
+  if (@_) {
+    my $pegrev = shift;
+
+    # Re-construct URL is necessary
+    if (! $self->pegrev or $pegrev ne $self->pegrev) {
+      $self->url_peg ($self->url . ($pegrev ? '@' . $pegrev : ''));
+    }
+  }
+
+  $self->_analyse_url () if not $self->{ANALYSED};
+
+  return $self->{PEGREV};
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Config.pm
===================================================================
--- vendors/FCM/lib/Fcm/Config.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Config.pm	(revision 9621)
@@ -0,0 +1,894 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Config
+#
+# DESCRIPTION
+#   This is a class for reading and processing central and user configuration
+#   settings for FCM.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Config;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Basename;
+use File::Spec::Functions;
+use FindBin;
+use POSIX qw/setlocale LC_ALL/;
+
+# FCM component modules
+use Fcm::CfgFile;
+
+# Other declarations:
+sub _get_hash_value;
+
+# Delimiter for setting and for list
+our $DELIMITER         = '::';
+our $DELIMITER_PATTERN = qr{::|/};
+our $DELIMITER_LIST    = ',';
+
+my $INSTANCE;
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $config = Fcm::Config->instance();
+#
+# DESCRIPTION
+#   Returns an instance of this class.
+# ------------------------------------------------------------------------------
+
+sub instance {
+    my ($class) = @_;
+    if (!defined($INSTANCE)) {
+        $INSTANCE = $class->new();
+        $INSTANCE->get_config();
+        $INSTANCE->is_initialising(0);
+    }
+    return $INSTANCE;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Config->new (VERBOSE => $verbose);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Config class.
+#
+# ARGUMENTS
+#   VERBOSE - Set the verbose level of diagnostic output
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  # Ensure that all subsequent Subversion output is in UK English
+  if (setlocale (LC_ALL, 'en_GB')) {
+    $ENV{LANG} = 'en_GB';
+  }
+
+  my $self = {
+    initialising   => 1,
+    central_config => undef,
+    user_config    => undef,
+    user_id        => undef,
+    verbose        => exists $args{VERBOSE} ? $args{VERBOSE} : undef,
+    variable       => {},
+
+    # Primary settings
+    setting => {
+      # Current command
+      FCM_COMMAND => &basename ($0),
+
+      # Current FCM release identifier
+      FCM_RELEASE => '1-5',
+
+      # Location of file with the last changed revision of the FCM trunk
+      FCM_REV_FILE => catfile (dirname ($FindBin::Bin), 'etc', 'fcm_rev'),
+
+      # Fortran BLOCKDATA dependencies
+      BLD_BLOCKDATA => {},
+
+      # Copy dummy target
+      BLD_CPDUMMY => '$(FCM_DONEDIR)/FCM_CP.dummy',
+
+      # No dependency check
+      BLD_DEP_N => {},
+
+      # Additional (PP) dependencies
+      BLD_DEP => {},
+      BLD_DEP_PP => {},
+
+      # Excluded dependency
+      BLD_DEP_EXCL => {
+        '' => [
+          # Fortran intrinsic modules
+          'USE' . $DELIMITER . 'ISO_C_BINDING',
+          'USE' . $DELIMITER . 'IEEE_EXCEPTIONS',
+          'USE' . $DELIMITER . 'IEEE_ARITHMETIC',
+          'USE' . $DELIMITER . 'IEEE_FEATURES',
+
+          # Fortran intrinsic subroutines
+          'OBJ' . $DELIMITER . 'CPU_TIME',
+          'OBJ' . $DELIMITER . 'GET_COMMAND',
+          'OBJ' . $DELIMITER . 'GET_COMMAND_ARGUMENT',
+          'OBJ' . $DELIMITER . 'GET_ENVIRONMENT_VARIABLE',
+          'OBJ' . $DELIMITER . 'MOVE_ALLOC',
+          'OBJ' . $DELIMITER . 'MVBITS',
+          'OBJ' . $DELIMITER . 'RANDOM_NUMBER',
+          'OBJ' . $DELIMITER . 'RANDOM_SEED',
+          'OBJ' . $DELIMITER . 'SYSTEM_CLOCK',
+
+          # Dummy statements
+          'OBJ' . $DELIMITER . 'NONE',
+          'EXE' . $DELIMITER . 'NONE',
+        ],
+      },
+
+      # Extra executable dependencies
+      BLD_DEP_EXE => {},
+
+      # Dependency pattern for each type
+      BLD_DEP_PATTERN => {
+        H         => q/^#\s*include\s*['"](\S+)['"]/,
+        USE       => q/^\s*use\s+(\w+)/,
+        INTERFACE => q/^#?\s*include\s+['"](\S+##OUTFILE_EXT/ . $DELIMITER .
+                     q/INTERFACE##)['"]/,
+        INC       => q/^\s*include\s+['"](\S+)['"]/,
+        OBJ       => q#^\s*(?:/\*|!)\s*depends\s*on\s*:\s*(\S+)#,
+        EXE       => q/^\s*(?:#|;)\s*(?:calls|list|if|interface)\s*:\s*(\S+)/,
+      },
+
+      # Rename main program targets
+      BLD_EXE_NAME => {},
+
+      # Rename library targets
+      BLD_LIB => {'' => 'fcm_default'},
+
+      # Name of Makefile and run environment shell script
+      BLD_MISC => {
+        'BLDMAKEFILE' => 'Makefile',
+        'BLDRUNENVSH' => 'fcm_env.sh',
+      },
+
+      # PP flags
+      BLD_PP => {},
+
+      # Custom source file type
+      BLD_TYPE => {},
+
+      # Types that always need to be built
+      BLD_TYPE_ALWAYS_BUILD =>                   'PVWAVE' .
+                               $DELIMITER_LIST . 'GENLIST' .
+                               $DELIMITER_LIST . 'SQL',
+
+      # Dependency scan types
+      BLD_TYPE_DEP => {
+        FORTRAN =>              'USE' .
+                   $DELIMITER . 'INTERFACE' .
+                   $DELIMITER . 'INC' .
+                   $DELIMITER . 'OBJ',
+        FPP     =>              'USE' .
+                   $DELIMITER . 'INTERFACE' .
+                   $DELIMITER . 'INC' .
+                   $DELIMITER . 'H' .
+                   $DELIMITER . 'OBJ',
+        CPP     =>              'H' .
+                   $DELIMITER . 'OBJ',
+        C       =>              'H' .
+                   $DELIMITER . 'OBJ',
+        SCRIPT  =>              'EXE',
+      },
+
+      # Dependency scan types for pre-processing
+      BLD_TYPE_DEP_PP => {
+        FPP => 'H',
+        CPP => 'H',
+        C   => 'H',
+      },
+
+      # Types that cannot have duplicated targets
+      BLD_TYPE_NO_DUPLICATED_TARGET => '',
+
+      # BLD_VPATH, each value must be a comma separate list
+      # ''     translates to %
+      # 'FLAG' translates to {OUTFILE_EXT}{FLAG}
+      BLD_VPATH   => {
+        BIN   => q{},
+        ETC   => 'ETC',
+        DONE  => join($DELIMITER_LIST, qw{DONE IDONE}),
+        FLAGS => 'FLAGS',
+        INC   => q{},
+        LIB   => 'LIB',
+        OBJ   => 'OBJ',
+      },
+
+      # Cache basename
+      CACHE          => '.config',
+      CACHE_DEP      => '.config_dep',
+      CACHE_DEP_PP   => '.config_dep_pp',
+      CACHE_FILE_SRC => '.config_file_src',
+
+      # Types of "inc" statements expandable CFG files
+      CFG_EXP_INC =>                   'BLD' .
+                     $DELIMITER_LIST . 'EXT' .
+                     $DELIMITER_LIST . 'FCM',
+
+      # Configuration file labels that can be declared more than once
+      CFG_KEYWORD =>                   'USE' .
+                     $DELIMITER_LIST . 'INC' .
+                     $DELIMITER_LIST . 'TARGET' .
+                     $DELIMITER_LIST . 'BLD_DEP_EXCL',
+
+      # Labels for all types of FCM configuration files
+      CFG_LABEL => {
+        CFGFILE => 'CFG', # config file information
+        INC     => 'INC', # "include" from an configuration file
+
+        # Labels for central/user internal config setting
+        SETTING => 'SET',
+
+        # Labels for systems that allow inheritance
+        DEST => 'DEST', # destination
+        USE  => 'USE',  # use (inherit) a previous configuration
+
+        # Labels for bld and pck cfg
+        TARGET => 'TARGET', # BLD: declare targets, PCK: target of source file
+
+        # Labels for bld cfg
+        BLD_BLOCKDATA => 'BLOCKDATA',   # declare Fortran BLOCKDATA dependencies
+        BLD_DEP       => 'DEP',         # additional dependencies
+        BLD_DEP_N     => 'NO_DEP',      # no dependency check
+        BLD_DEP_EXCL  => 'EXCL_DEP',    # exclude automatic dependencies
+        BLD_DEP_EXE   => 'EXE_DEP',     # declare dependencies for program
+        BLD_EXE_NAME  => 'EXE_NAME',    # rename a main program
+        BLD_LIB       => 'LIB',         # rename library
+        BLD_PP        => 'PP',          # sub-package needs pre-process?
+        BLD_TYPE      => 'SRC_TYPE',    # custom source file type
+        DIR           => 'DIR',         # DEPRECATED, same as DEST
+        INFILE_EXT    => 'INFILE_EXT',  # change input file name extension type
+        INHERIT       => 'INHERIT',     # inheritance flag
+        NAME          => 'NAME',        # name the build
+        OUTFILE_EXT   => 'OUTFILE_EXT', # change output file type extension
+        FILE          => 'SRC',         # declare a sub-package
+        SEARCH_SRC    => 'SEARCH_SRC',  # search src/ sub-directory?
+        TOOL          => 'TOOL',        # declare a tool
+
+        # Labels for ext cfg
+        BDECLARE   => 'BLD',      # build declaration
+        CONFLICT   => 'CONFLICT', # set conflict mode
+        DIRS       => 'SRC',      # declare source directory
+        EXPDIRS    => 'EXPSRC',   # declare expandable source directory
+        MIRROR     => 'MIRROR',   # DEPRECATED, same as RDEST::MIRROR_CMD
+        OVERRIDE   => 'OVERRIDE', # DEPRECATED, replaced by CONFLICT
+        RDEST      => 'RDEST',    # declare remote destionation
+        REVISION   => 'REVISION', # declare branch revision in a project
+        REVMATCH   => 'REVMATCH', # branch revision must match changed revision
+        REPOS      => 'REPOS',    # declare branch in a project
+        VERSION    => 'VERSION',  # DEPRECATED, same as REVISION
+      },
+
+      # Default names of known FCM configuration files
+      CFG_NAME => {
+        BLD        => 'bld.cfg',      # build configuration file
+        EXT        => 'ext.cfg',      # extract configuration file
+        PARSED     => 'parsed_',      # as-parsed configuration file prefix
+      },
+
+      # Latest version of known FCM configuration files
+      CFG_VERSION => {
+        BLD        => '1.0', # bld cfg
+        EXT        => '1.0', # ext cfg
+      },
+
+      # Standard sub-directories for extract/build
+      DIR => {
+        BIN    => 'bin',    # executable
+        BLD    => 'bld',    # build
+        CACHE  => '.cache', # cache
+        CFG    => 'cfg',    # configuration
+        DONE   => 'done',   # "done"
+        ETC    => 'etc',    # miscellaneous items
+        FLAGS  => 'flags',  # "flags"
+        INC    => 'inc',    # include
+        LIB    => 'lib',    # library
+        OBJ    => 'obj',    # object
+        PPSRC  => 'ppsrc',  # pre-processed source
+        SRC    => 'src',    # source
+        TMP    => 'tmp',    # temporary directory
+      },
+
+      # A flag to indicate whether the revision of a given branch for extract
+      # must match with the revision of a changed revision of the branch
+      EXT_REVMATCH => 0, # default is false (allow any revision)
+
+      # Input file name extension and type
+      # (may overlap with output (below) and vpath (above))
+      INFILE_EXT => {
+        # General extensions
+        'f'    =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'for'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'ftn'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'f77'  =>              'FORTRAN' .
+                  $DELIMITER . 'SOURCE',
+        'f90'  =>              'FORTRAN' .
+                  $DELIMITER . 'FORTRAN9X' .
+                  $DELIMITER . 'SOURCE',
+        'f95'  =>              'FORTRAN' .
+                  $DELIMITER . 'FORTRAN9X' .
+                  $DELIMITER . 'SOURCE',
+        'F'    =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'FOR'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'FTN'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'F77'  =>              'FPP' .
+                  $DELIMITER . 'SOURCE',
+        'F90'  =>              'FPP' .
+                  $DELIMITER . 'FPP9X' .
+                  $DELIMITER . 'SOURCE',
+        'F95'  =>              'FPP' .
+                  $DELIMITER . 'FPP9X' .
+                  $DELIMITER . 'SOURCE',
+        'c'    =>              'C' .
+                  $DELIMITER . 'SOURCE',
+        'cpp'  =>              'C' .
+                  $DELIMITER . 'C++' .
+                  $DELIMITER . 'SOURCE',
+        'h'    =>              'CPP' .
+                  $DELIMITER . 'INCLUDE',
+        'o'    =>              'BINARY' .
+                  $DELIMITER . 'OBJ',
+        'obj'  =>              'BINARY' .
+                  $DELIMITER . 'OBJ',
+        'exe'  =>              'BINARY' .
+                  $DELIMITER . 'EXE',
+        'a'    =>              'BINARY' .
+                  $DELIMITER . 'LIB',
+        'sh'   =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'ksh'  =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'bash' =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'csh'  =>              'SCRIPT' .
+                  $DELIMITER . 'SHELL',
+        'pl'   =>              'SCRIPT' .
+                  $DELIMITER . 'PERL',
+        'pm'   =>              'SCRIPT' .
+                  $DELIMITER . 'PERL',
+        'py'   =>              'SCRIPT' .
+                  $DELIMITER . 'PYTHON',
+        'tcl'  =>              'SCRIPT' .
+                  $DELIMITER . 'TCL',
+        'pro'  =>              'SCRIPT' .
+                  $DELIMITER . 'PVWAVE',
+
+        # Local extensions
+        'cfg'       =>              'CFGFILE',
+        'h90'       =>              'CPP' .
+                       $DELIMITER . 'INCLUDE',
+        'inc'       =>              'FORTRAN' .
+                       $DELIMITER . 'FORTRAN9X' .
+                       $DELIMITER . 'INCLUDE',
+        'interface' =>              'FORTRAN' .
+                       $DELIMITER . 'FORTRAN9X' .
+                       $DELIMITER . 'INCLUDE' .
+                       $DELIMITER . 'INTERFACE',
+      },
+
+      # Ignore input files matching the following names (comma-separated list)
+      INFILE_IGNORE =>                   'fcm_env.ksh' .
+                       $DELIMITER_LIST . 'fcm_env.sh',
+
+      # Input file name pattern and type
+      INFILE_PAT => {
+        '\w+Scr_\w+'              =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL',
+        '\w+Comp_\w+'             =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENTASK',
+        '\w+(?:IF|Interface)_\w+' =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENIF',
+        '\w+Suite_\w+'            =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENSUITE',
+        '\w+List_\w+'             =>              'SCRIPT' .
+                                     $DELIMITER . 'SHELL' .
+                                     $DELIMITER . 'GENLIST',
+        '\w+Sql_\w+'              =>              'SCRIPT' .
+                                     $DELIMITER . 'SQL',
+      },
+
+      # Input text file pattern and type
+      INFILE_TXT => {
+        '(?:[ck]|ba)?sh'  =>              'SCRIPT' .
+                             $DELIMITER . 'SHELL',
+        'perl'            =>              'SCRIPT' .
+                             $DELIMITER . 'PERL',
+        'python'          =>              'SCRIPT' .
+                             $DELIMITER . 'PYTHON',
+        'tcl(?:sh)?|wish' =>              'SCRIPT' .
+                             $DELIMITER . 'TCL',
+      },
+
+      # Lock file
+      LOCK => {
+        BLDLOCK => 'fcm.bld.lock', # build lock file
+        EXTLOCK => 'fcm.ext.lock', # extract lock file
+      },
+
+      # Output file type and extension
+      # (may overlap with input and vpath (above))
+      OUTFILE_EXT => {
+        CFG       => '.cfg',       # FCM configuration file
+        DONE      => '.done',      # "done" files for compiled source
+        ETC       => '.etc',       # "etc" dummy file
+        EXE       => '.exe',       # binary executables
+        FLAGS     => '.flags',     # "flags" files, compiler flags config
+        IDONE     => '.idone',     # "done" files for included source
+        INTERFACE => '.interface', # interface for F90 subroutines/functions
+        LIB       => '.a',         # archive object library
+        MOD       => '.mod',       # compiled Fortran module information files
+        OBJ       => '.o',         # compiled object files
+        PDONE     => '.pdone',     # "done" files for pre-processed files
+        TAR       => '.tar',       # TAR archive
+      },
+
+      # Build commands and options (i.e. tools)
+      TOOL => {
+        SHELL        => '/bin/sh',         # Default shell
+
+        CPP          => 'cpp',             # C pre-processor
+        CPPFLAGS     => '-C',              # CPP flags
+        CPP_INCLUDE  => '-I',              # CPP flag, specify "include" path
+        CPP_DEFINE   => '-D',              # CPP flag, define macro
+        CPPKEYS      => '',                # CPP keys (definition macro)
+
+        CC           => 'cc',              # C compiler
+        CFLAGS       => '',                # CC flags
+        CC_COMPILE   => '-c',              # CC flag, compile only
+        CC_OUTPUT    => '-o',              # CC flag, specify output file name
+        CC_INCLUDE   => '-I',              # CC flag, specify "include" path
+        CC_DEFINE    => '-D',              # CC flag, define macro
+
+        FPP          => 'cpp',             # Fortran pre-processor
+        FPPFLAGS     => '-P -traditional', # FPP flags
+        FPP_INCLUDE  => '-I',              # FPP flag, specify "include" path
+        FPP_DEFINE   => '-D',              # FPP flag, define macro
+        FPPKEYS      => '',                # FPP keys (definition macro)
+
+        FC           => 'f90',             # Fortran compiler
+        FFLAGS       => '',                # FC flags
+        FC_COMPILE   => '-c',              # FC flag, compile only
+        FC_OUTPUT    => '-o',              # FC flag, specify output file name
+        FC_INCLUDE   => '-I',              # FC flag, specify "include" path
+        FC_MODSEARCH => '',                # FC flag, specify "module" path
+        FC_DEFINE    => '-D',              # FC flag, define macro
+
+        LD           => '',                # linker
+        LDFLAGS      => '',                # LD flags
+        LD_OUTPUT    => '-o',              # LD flag, specify output file name
+        LD_LIBSEARCH => '-L',              # LD flag, specify "library" path
+        LD_LIBLINK   => '-l',              # LD flag, specify link library
+
+        AR           => 'ar',              # library archiver
+        ARFLAGS      => 'rs',              # AR flags
+
+        MAKE         => 'make',            # make command
+        MAKEFLAGS    => '',                # make flags
+        MAKE_FILE    => '-f',              # make flag, path to Makefile
+        MAKE_SILENT  => '-s',              # make flag, silent diagnostic
+        MAKE_JOB     => '-j',              # make flag, number of jobs
+
+        INTERFACE    => 'file',            # name interface after file/program
+        GENINTERFACE => '',                # Fortran 9x interface generator
+
+        DIFF3        => 'diff3',           # extract diff3 merge
+        DIFF3FLAGS   => '-E -m',           # DIFF3 flags
+        GRAPHIC_DIFF => 'xxdiff',          # graphical diff tool
+        GRAPHIC_MERGE=> 'xxdiff',          # graphical merge tool
+      },
+
+      # List of tools that are local to FCM, (will not be exported to a Makefile)
+      TOOL_LOCAL =>                   'CPP' .
+                    $DELIMITER_LIST . 'CPPFLAGS' .
+                    $DELIMITER_LIST . 'CPP_INCLUDE' .
+                    $DELIMITER_LIST . 'CPP_DEFINE' .
+                    $DELIMITER_LIST . 'DIFF3' .
+                    $DELIMITER_LIST . 'DIFF3_FLAGS' .
+                    $DELIMITER_LIST . 'FPP' .
+                    $DELIMITER_LIST . 'FPPFLAGS' .
+                    $DELIMITER_LIST . 'FPP_INCLUDE' .
+                    $DELIMITER_LIST . 'FPP_DEFINE' .
+                    $DELIMITER_LIST . 'GRAPHIC_DIFF' .
+                    $DELIMITER_LIST . 'GRAPHIC_MERGE' .
+                    $DELIMITER_LIST . 'MAKE' .
+                    $DELIMITER_LIST . 'MAKEFLAGS' .
+                    $DELIMITER_LIST . 'MAKE_FILE' .
+                    $DELIMITER_LIST . 'MAKE_SILENT' .
+                    $DELIMITER_LIST . 'MAKE_JOB' .
+                    $DELIMITER_LIST . 'INTERFACE' .
+                    $DELIMITER_LIST . 'GENINTERFACE' .
+                    $DELIMITER_LIST . 'MIRROR' .
+                    $DELIMITER_LIST . 'REMOTE_SHELL',
+
+      # List of tools that allow sub-package declarations
+      TOOL_PACKAGE =>                   'CPPFLAGS' .
+                      $DELIMITER_LIST . 'CPPKEYS' .
+                      $DELIMITER_LIST . 'CFLAGS' .
+                      $DELIMITER_LIST . 'FPPFLAGS' .
+                      $DELIMITER_LIST . 'FPPKEYS' .
+                      $DELIMITER_LIST . 'FFLAGS' .
+                      $DELIMITER_LIST . 'LD' .
+                      $DELIMITER_LIST . 'LDFLAGS' .
+                      $DELIMITER_LIST . 'INTERFACE' .
+                      $DELIMITER_LIST . 'GENINTERFACE',
+
+      # Supported tools for compilable source
+      TOOL_SRC_PP => {
+        FPP     => {
+          COMMAND => 'FPP',
+          FLAGS   => 'FPPFLAGS',
+          PPKEYS  => 'FPPKEYS',
+          INCLUDE => 'FPP_INCLUDE',
+          DEFINE  => 'FPP_DEFINE',
+        },
+
+        C       => {
+          COMMAND => 'CPP',
+          FLAGS   => 'CPPFLAGS',
+          PPKEYS  => 'CPPKEYS',
+          INCLUDE => 'CPP_INCLUDE',
+          DEFINE  => 'CPP_DEFINE',
+        },
+      },
+
+      # Supported tools for compilable source
+      TOOL_SRC => {
+        FORTRAN => {
+          COMMAND => 'FC',
+          FLAGS   => 'FFLAGS',
+          OUTPUT  => 'FC_OUTPUT',
+          INCLUDE => 'FC_INCLUDE',
+        },
+
+        FPP     => {
+          COMMAND => 'FC',
+          FLAGS   => 'FFLAGS',
+          PPKEYS  => 'FPPKEYS',
+          OUTPUT  => 'FC_OUTPUT',
+          INCLUDE => 'FC_INCLUDE',
+          DEFINE  => 'FC_DEFINE',
+        },
+
+        C       => {
+          COMMAND => 'CC',
+          FLAGS   => 'CFLAGS',
+          PPKEYS  => 'CPPKEYS',
+          OUTPUT  => 'CC_OUTPUT',
+          INCLUDE => 'CC_INCLUDE',
+          DEFINE  => 'CC_DEFINE',
+        },
+      },
+
+      # FCM URL keyword and prefix, FCM revision keyword, and FCM Trac URL
+      URL          => {},
+      URL_REVISION => {},
+
+      URL_BROWSER_MAPPING => {},
+      URL_BROWSER_MAPPING_DEFAULT => {
+        LOCATION_COMPONENT_PATTERN
+        => qr{\A // ([^/]+) /+ ([^/]+)_svn /+(.*) \z}xms,
+        BROWSER_URL_TEMPLATE
+        => 'http://{1}/projects/{2}/intertrac/source:{3}{4}',
+        BROWSER_REV_TEMPLATE => '@{1}',
+      },
+
+      # Default web browser
+      WEB_BROWSER   => 'firefox',
+    },
+  };
+
+  # Backward compatibility: the REPOS setting is equivalent to the URL setting
+  $self->{setting}{REPOS} = $self->{setting}{URL};
+
+  # Alias the REVISION and TRAC setting to URL_REVISION and URL_TRAC
+  $self->{setting}{REVISION} = $self->{setting}{URL_REVISION};
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in the "new" method.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/central_config user_config user_id verbose/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'central_config') {
+        # Central configuration file
+        if (-r catfile (dirname ($FindBin::Bin), 'etc', 'fcm.cfg')) {
+          $self->{$name} = catfile (
+            dirname ($FindBin::Bin), 'etc', 'fcm.cfg'
+          );
+
+        } elsif (-r catfile ($FindBin::Bin, 'fcm.cfg')) {
+          $self->{$name} = catfile ($FindBin::Bin, 'fcm.cfg');
+        }
+
+      } elsif ($name eq 'user_config') {
+        # User configuration file
+        my $home = (getpwuid ($<))[7];
+        $home = $ENV{HOME} if not defined $home;
+        $self->{$name} = catfile ($home, '.fcm')
+          if defined ($home) and -r catfile ($home, '.fcm');
+
+      } elsif ($name eq 'user_id') {
+        # User ID of current process
+        my $user = (getpwuid ($<))[0];
+        $user = $ENV{LOGNAME} if not defined $user;
+        $user = $ENV{USER} if not defined $user;
+        $self->{$name} = $user;
+
+      } elsif ($name eq 'verbose') {
+        # Verbose mode
+        $self->{$name} = exists $ENV{FCM_VERBOSE} ? $ENV{FCM_VERBOSE} : 1;
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = $obj->is_initialising();
+#
+# DESCRIPTION
+#   Returns true if this object is initialising.
+# ------------------------------------------------------------------------------
+sub is_initialising {
+  my ($self, $value) = @_;
+  if (defined($value)) {
+    $self->{initialising} = $value;
+  }
+  return $self->{initialising};
+}
+
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in the "new" method.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (qw/variable/) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $setting = $obj->setting (@labels);
+#   $obj->setting (\@labels, $setting);
+#
+# DESCRIPTION
+#   This method returns/sets an item under the setting hash table. The depth
+#   within the hash table is given by the list of arguments @labels, which
+#   should match with the keys in the multi-dimension setting hash table.
+# ------------------------------------------------------------------------------
+
+sub setting {
+  my $self = shift;
+
+  if (@_) {
+    my $arg1 = shift;
+    my $s    = $self->{setting};
+
+    if (ref ($arg1) eq 'ARRAY') {
+      # Assign setting
+      # ------------------------------------------------------------------------
+      my $value = shift;
+
+      while (defined (my $label = shift @$arg1)) {
+        if (exists $s->{$label}) {
+          if (ref $s->{$label} eq 'HASH') {
+            $s = $s->{$label};
+
+          } else {
+            $s->{$label} = $value;
+            last;
+          }
+
+        } else {
+          if (@$arg1) {
+            $s->{$label} = {};
+            $s           = $s->{$label};
+
+          } else {
+            $s->{$label} = $value;
+          }
+        }
+      }
+
+    } else {
+      # Get setting
+      # ------------------------------------------------------------------------
+      return _get_hash_value ($s->{$arg1}, @_) if exists $s->{$arg1};
+    }
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->get_config ();
+#
+# DESCRIPTION
+#   This method reads the configuration settings from the central and the user
+#   configuration files.
+# ------------------------------------------------------------------------------
+
+sub get_config {
+  my $self = shift;
+
+  $self->_read_config_file ($self->central_config);  
+  $self->_read_config_file ($self->user_config);
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj->_read_config_file ();
+#
+# DESCRIPTION
+#   This internal method reads a configuration file and assign values to the
+#   attributes of the current instance.
+# ------------------------------------------------------------------------------
+
+sub _read_config_file {
+  my $self        = shift;
+  my $config_file = $_[0];
+
+  if (!$config_file || !-f $config_file || !-r $config_file) {
+    return;
+  }
+
+  my $cfgfile = Fcm::CfgFile->new (SRC => $config_file, TYPE => 'FCM');
+  $cfgfile->read_cfg ();
+
+  LINE: for my $line (@{ $cfgfile->lines }) {
+    next unless $line->label;
+
+    # "Environment variables" start with $
+    if ($line->label =~ /^\$([A-Za-z_]\w*)$/) {
+      $ENV{$1} = $line->value;
+      next LINE;
+    }
+
+    # "Settings variables" start with "set"
+    if ($line->label_starts_with_cfg ('SETTING')) {
+      my @tags = $line->label_fields;
+      shift @tags;
+      @tags = map {uc} @tags;
+      $self->setting (\@tags, $line->value);
+      next LINE;
+    }
+
+    # Not a standard setting variable, put in internal variable list
+    (my $label = $line->label) =~ s/^\%//;
+    $self->variable ($label, $line->value);
+  }
+
+  1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $ref = _get_hash_value (arg1, arg2, ...);
+#
+# DESCRIPTION
+#   This internal method recursively gets a value from a multi-dimensional
+#   hash.
+# ------------------------------------------------------------------------------
+
+sub _get_hash_value {
+  my $value = shift;
+
+  while (defined (my $arg = shift)) {
+    if (exists $value->{$arg}) {
+      $value = $value->{$arg};
+
+    } else {
+      return undef;
+    }
+  }
+
+  return $value;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/ConfigSystem.pm
===================================================================
--- vendors/FCM/lib/Fcm/ConfigSystem.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/ConfigSystem.pm	(revision 9621)
@@ -0,0 +1,735 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ConfigSystem
+#
+# DESCRIPTION
+#   This is the base class for FCM systems that are based on inherited
+#   configuration files, e.g. the extract and the build systems.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ConfigSystem;
+use base qw{Fcm::Base};
+
+use strict;
+use warnings;
+
+use Fcm::CfgFile;
+use Fcm::CfgLine;
+use Fcm::Dest;
+use Fcm::Util     qw{expand_tilde e_report w_report};
+use Sys::Hostname qw{hostname};
+
+# List of property methods for this class
+my @scalar_properties = (
+ 'cfg',         # configuration file
+ 'cfg_methods', # list of sub-methods for parse_cfg
+ 'cfg_prefix',  # optional prefix in configuration declaration
+ 'dest',        # destination for output
+ 'inherit',     # list of inherited configurations
+ 'inherited',   # list of inheritance hierarchy
+ 'type',        # system type
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ConfigSystem->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ConfigSystem class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  $self->cfg_methods ([qw/header inherit dest/]);
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'cfg') {
+        # New configuration file
+        $self->{$name} = Fcm::CfgFile->new (TYPE => $self->type);
+
+      } elsif ($name =~ /^(?:cfg_methods|inherit|inherited)$/) {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'cfg_prefix' or $name eq 'type') {
+        # Reference to an array
+        $self->{$name} = '';
+
+      } elsif ($name eq 'dest') {
+        # New destination
+        $self->{$name} = Fcm::Dest->new (TYPE => $self->type);
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $out_of_date) = $obj->check_cache ();
+#
+# DESCRIPTION
+#   This method returns $rc = 1 on success or undef on failure. It returns
+#   $out_of_date = 1 if current cache file is out of date relative to those in
+#   inherited runs or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub check_cache {
+  my $self = shift;
+
+  my $rc = 1;
+  my $out_of_date = 0;
+
+  if (@{ $self->inherit } and -f $self->dest->cache) {
+    # Get modification time of current cache file
+    my $cur_mtime = (stat ($self->dest->cache))[9];
+
+    # Compare with modification times of inherited cache files
+    for my $use (@{ $self->inherit }) {
+      next unless -f $use->dest->cache;
+      my $use_mtime = (stat ($use->dest->cache))[9];
+      $out_of_date = 1 if $use_mtime > $cur_mtime;
+    }
+  }
+
+  return ($rc, $out_of_date);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->check_lock ();
+#
+# DESCRIPTION
+#   This method returns true if no lock is found in the destination or if the
+#   locks found are allowed. 
+# ------------------------------------------------------------------------------
+
+sub check_lock {
+  my $self = shift;
+
+  # Check all types of locks
+  for my $method (@Fcm::Dest::lockfiles) {
+    my $lock = $self->dest->$method;
+
+    # Check whether lock exists
+    next unless -e $lock;
+
+    # Check whether this lock is allowed
+    next if $self->check_lock_is_allowed ($lock);
+
+    # Throw error if a lock exists
+    w_report 'ERROR: ', $lock, ': lock file exists,';
+    w_report '       ', $self->dest->rootdir, ': destination is busy.';
+    return;
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->check_lock_is_allowed ($lock);
+#
+# DESCRIPTION
+#   This method returns true if it is OK for $lock to exist in the destination.
+# ------------------------------------------------------------------------------
+
+sub check_lock_is_allowed {
+  my ($self, $lock) = @_;
+
+  # Disallow all types of locks by default
+  return 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->compare_setting (
+#     METHOD_LIST  => \@method_list,
+#     [METHOD_ARGS => \@method_args,]
+#     [CACHEBASE   => $cachebase,]
+#   );
+#
+# DESCRIPTION
+#   This method gets settings from the previous cache and updates the current.
+#
+# METHOD
+#   The method returns true on success. @method_list must be a list of method
+#   names for processing the cached lines in the previous run. If an existing
+#   cache exists, its content is read into $old_lines, which is a list of
+#   Fcm::CfgLine objects. Otherwise, $old_lines is set to undef. If $cachebase
+#   is set, it is used for as the cache basename. Otherwise, the default for
+#   the current system is used. It calls each method in the @method_list using
+#   $self->$method ($old_lines, @method_args), which should return a
+#   two-element list. The first element should be a return code (1 for out of
+#   date, 0 for up to date and undef for failure). The second element should be
+#   a reference to a list of Fcm::CfgLine objects for the output.
+# ------------------------------------------------------------------------------
+
+sub compare_setting {
+  my ($self, %args) = @_;
+
+  my @method_list = exists ($args{METHOD_LIST}) ? @{ $args{METHOD_LIST} } : ();
+  my @method_args = exists ($args{METHOD_ARGS}) ? @{ $args{METHOD_ARGS} } : ();
+  my $cachebase   = exists ($args{CACHEBASE}) ? $args{CACHEBASE} : undef;
+
+  my $rc = 1;
+
+  # Read cache if the file exists
+  # ----------------------------------------------------------------------------
+  my $cache = $cachebase
+              ? File::Spec->catfile ($self->dest->cachedir, $cachebase)
+              : $self->dest->cache;
+  my @in_caches = ();
+  if (-r $cache) {
+    push @in_caches, $cache;
+
+  } else {
+    for my $use (@{ $self->inherit }) {
+      my $use_cache = $cachebase
+                      ? File::Spec->catfile ($use->dest->cachedir, $cachebase)
+                      : $use->dest->cache;
+      push @in_caches, $use_cache if -r $use_cache;
+    }
+  }
+
+  my $old_lines = undef;
+  for my $in_cache (@in_caches) {
+    next unless -r $in_cache;
+    my $cfg = Fcm::CfgFile->new (SRC => $in_cache);
+
+    if ($cfg->read_cfg) {
+      $old_lines = [] if not defined $old_lines;
+      push @$old_lines, @{ $cfg->lines };
+    }
+  }
+
+  # Call methods in @method_list to see if cache is out of date
+  # ----------------------------------------------------------------------------
+  my @new_lines = ();
+  my $out_of_date = 0;
+  for my $method (@method_list) {
+    my ($return, $lines);
+    ($return, $lines) = $self->$method ($old_lines, @method_args) if $rc;
+
+    if (defined $return) {
+      # Method succeeded
+      push @new_lines, @$lines;
+      $out_of_date = 1 if $return;
+
+    } else {
+      # Method failed
+      $rc = $return;
+      last;
+    }
+  }
+
+  # Update the cache in the current run
+  # ----------------------------------------------------------------------------
+  if ($rc) {
+    if (@{ $self->inherited } and $out_of_date) {
+      # If this is an inherited configuration, the cache must not be changed
+      w_report 'ERROR: ', $self->cfg->src,
+               ': inherited configuration does not match with its cache.';
+      $rc = undef;
+
+    } elsif ((not -f $cache) or $out_of_date) {
+      my $cfg = Fcm::CfgFile->new;
+      $cfg->lines ([sort {$a->label cmp $b->label} @new_lines]);
+      $rc = $cfg->print_cfg ($cache, 1);
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($changed_hash_ref, $new_lines_array_ref) =
+#     $self->compare_setting_in_config($prefix, \@old_lines);
+#
+# DESCRIPTION
+#   This method compares old and current settings for a specified item.
+#
+# METHOD
+#   This method does two things.
+#
+#   It uses the current configuration for the $prefix item to generate a list of
+#   new Fcm::CfgLine objects (which is returned as a reference in the second
+#   element of the returned list).
+#
+#   The values of the old lines are then compared with those of the new lines.
+#   Any settings that are changed are stored in a hash, which is returned as a
+#   reference in the first element of the returned list. The key of the hash is
+#   the name of the changed setting, and the value is the value of the new
+#   setting or undef if the setting no longer exists.
+#
+# ARGUMENTS
+#   $prefix    - the name of an item in Fcm::Config to be compared
+#   @old_lines - a list of Fcm::CfgLine objects containing the old settings
+# ------------------------------------------------------------------------------
+
+sub compare_setting_in_config {
+  my ($self, $prefix, $old_lines_ref) = @_;
+  
+  my %changed = %{$self->setting($prefix)};
+  my (@new_lines, %new_val_of);
+  while (my ($key, $val) = each(%changed)) {
+    $new_val_of{$key} = (ref($val) eq 'ARRAY' ? join(q{ }, sort(@{$val})) : $val);
+    push(@new_lines, Fcm::CfgLine->new(
+      LABEL => $prefix . $Fcm::Config::DELIMITER . $key,
+      VALUE => $new_val_of{$key},
+    ));
+  }
+
+  if (defined($old_lines_ref)) {
+    my %old_val_of
+      = map {($_->label_from_field(1), $_->value())} # converts into a hash
+        grep {$_->label_starts_with($prefix)}        # gets relevant lines
+        @{$old_lines_ref};
+
+    while (my ($key, $val) = each(%old_val_of)) {
+      if (exists($changed{$key})) {
+        if ($val eq $new_val_of{$key}) { # no change from old to new
+          delete($changed{$key});
+        }
+      }
+      else { # exists in old but not in new
+        $changed{$key} = undef;
+      }
+    }
+  }
+
+  return (\%changed, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->invoke ([CLEAN => 1, ]%args);
+#
+# DESCRIPTION
+#   This method invokes the system. If CLEAN is set to true, it will only parse
+#   the configuration and set up the destination, but will not invoke the
+#   system. See the invoke_setup_dest and the invoke_system methods for list of
+#   other arguments in %args.
+# ------------------------------------------------------------------------------
+
+sub invoke {
+  my $self = shift;
+  my %args = @_;
+
+  # Print diagnostic at beginning of run
+  # ----------------------------------------------------------------------------
+  # Name of the system
+  (my $name = ref ($self)) =~ s/^Fcm:://;
+
+  # Print start time on system run, if verbose is true
+  my $date = localtime;
+  print $name, ' command started on ', $date, '.', "\n"
+    if $self->verbose;
+
+  # Start time (seconds since epoch)
+  my $otime = time;
+
+  # Parse the configuration file
+  my $rc = $self->invoke_stage ('Parse configuration', 'parse_cfg');
+
+  # Set up the destination
+  $rc = $self->invoke_stage ('Setup destination', 'invoke_setup_dest', %args)
+    if $rc;
+
+  # Invoke the system
+  # ----------------------------------------------------------------------------
+  $rc = $self->invoke_system (%args) if $rc and not $args{CLEAN};
+
+  # Remove empty directories
+  $rc = $self->dest->clean (MODE => 'EMPTY') if $rc;
+
+  # Print diagnostic at end of run
+  # ----------------------------------------------------------------------------
+  # Print lapse time at the end, if verbose is true
+  if ($self->verbose) {
+    my $total = time - $otime;
+    my $s_str = $total > 1 ? 'seconds' : 'second';
+    print '->TOTAL: ', $total, ' ', $s_str, "\n";
+  }
+
+  # Report end of system run
+  $date = localtime;
+  if ($rc) {
+    # Success
+    print $name, ' command finished on ', $date, '.', "\n"
+      if $self->verbose;
+
+  } else {
+    # Failure
+    e_report $name, ' failed on ', $date, '.';
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->invoke_setup_dest ([CLEAN|FULL => 1], [IGNORE_LOCK => 1]);
+#
+# DESCRIPTION
+#   This method sets up the destination and returns true on success.
+#
+# ARGUMENTS
+#   CLEAN|FULL   - If set to "true", set up the system in "clean|full" mode.
+#                  Sub-directories and files in the root directory created by
+#                  the previous invocation of the system will be removed. If
+#                  not set, the default is to run in "incremental" mode.
+#   IGNORE_LOCK  - If set to "true", it ignores any lock files that may exist in
+#                  the destination root directory. 
+# ------------------------------------------------------------------------------
+
+sub invoke_setup_dest {
+  my $self = shift;
+  my %args = @_;
+
+  # Set up destination
+  # ----------------------------------------------------------------------------
+  # Print destination in verbose mode
+  if ($self->verbose()) {
+    printf(
+      "Destination: %s@%s:%s\n",
+      scalar(getpwuid($<)),
+      hostname(),
+      $self->dest()->rootdir(),
+    );
+  }
+
+  my $rc = 1;
+  my $out_of_date = 0;
+
+  # Check whether lock exists in the destination root
+  $rc = $self->check_lock if $rc and not $args{IGNORE_LOCK};
+
+  # Check whether current cache is out of date relative to the inherited ones
+  ($rc, $out_of_date) = $self->check_cache if $rc;
+
+  # Remove sub-directories and files in destination in "full" mode
+  $rc = $self->dest->clean (MODE => 'ALL')
+    if $rc and ($args{FULL} or $args{CLEAN} or $out_of_date);
+
+  # Create build root directory if necessary
+  $rc = $self->dest->create if $rc;
+
+  # Set a lock in the destination root
+  $rc = $self->dest->set_lock if $rc;
+
+  # Generate an as-parsed configuration file
+  $self->cfg->print_cfg ($self->dest->parsedcfg);
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_stage ($name, $method, @args);
+#
+# DESCRIPTION
+#   This method invokes a named stage of the system, where $name is the name of
+#   the stage, $method is the name of the method for invoking the stage and
+#   @args are the arguments to the &method.
+# ------------------------------------------------------------------------------
+
+sub invoke_stage {
+  my ($self, $name, $method, @args) = @_;
+
+  # Print diagnostic at beginning of a stage
+  print '->', $name, ': start', "\n" if $self->verbose;
+  my $stime = time;
+
+  # Invoke the stage
+  my $rc = $self->$method (@args);
+
+  # Print diagnostic at end of a stage
+  my $total = time - $stime;
+  my $s_str = $total > 1 ? 'seconds' : 'second';
+  print '->', $name, ': ', $total, ' ', $s_str, "\n";
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system (%args);
+#
+# DESCRIPTION
+#   This is a prototype method for invoking the system.
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+  my %args = @_;
+
+  print "Dummy code.\n";
+
+  return 0;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->parse_cfg ();
+#
+# DESCRIPTION
+#   This method calls other methods to parse the configuration file.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg {
+  my $self = shift;
+
+  return unless $self->cfg->src;
+
+  # Read config file
+  # ----------------------------------------------------------------------------
+  return unless $self->cfg->read_cfg;
+
+  if ($self->cfg->type ne $self->type) {
+    w_report 'ERROR: ', $self->cfg->src, ': not a ', $self->type,
+             ' config file.';
+    return;
+  }
+
+  # Strip out optional prefix from all labels
+  # ----------------------------------------------------------------------------
+  if ($self->cfg_prefix) {
+    for my $line (@{ $self->cfg->lines }) {
+      $line->prefix ($self->cfg_prefix);
+    }
+  }
+
+  # Filter lines from the configuration file
+  # ----------------------------------------------------------------------------
+  my @cfg_lines = grep {
+    $_->slabel                   and       # ignore empty/comment lines
+    index ($_->slabel, '%') != 0 and       # ignore user variable
+    not $_->slabel_starts_with_cfg ('INC') # ignore INC line
+  } @{ $self->cfg->lines };
+
+  # Parse the lines to read in the various settings, by calling the methods:
+  # $self->parse_cfg_XXX, where XXX is: header, inherit, dest, and the values
+  # in the list @{ $self->cfg_methods }.
+  # ----------------------------------------------------------------------------
+  my $rc = 1;
+  for my $name (@{ $self->cfg_methods }) {
+    my $method = 'parse_cfg_' . $name;
+    $self->$method (\@cfg_lines) or $rc = 0;
+  }
+
+  # Report warnings/errors
+  # ----------------------------------------------------------------------------
+  for my $line (@cfg_lines) {
+    $rc = 0 if not $line->parsed;
+    my $mesg = $line->format_error;
+    w_report $mesg if $mesg;
+  }
+
+  return ($rc);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_dest (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_dest {
+  my ($self, $cfg_lines) = @_;
+
+  my $rc = 1;
+
+  # DEST/DIR declarations
+  # ----------------------------------------------------------------------------
+  my @lines  = grep {
+    $_->slabel_starts_with_cfg ('DEST') or $_->slabel_starts_with_cfg ('DIR')
+  } @$cfg_lines;
+
+  # Only ROOTDIR declarations are accepted
+  for my $line (@lines) {
+    my ($d, $method) = $line->slabel_fields;
+    $d = lc $d;
+    $method = lc $method;
+
+    # Backward compatibility
+    $d = 'dest' if $d eq 'dir';
+
+    # Default to "rootdir"
+    $method = 'rootdir' if (not $method) or $method eq 'root';
+
+    # Only "rootdir" can be set
+    next unless $method eq 'rootdir';
+
+    $self->$d->$method (&expand_tilde ($line->value));
+    $line->parsed (1);
+  }
+
+  # Make sure root directory is set
+  # ----------------------------------------------------------------------------
+  if (not $self->dest->rootdir) {
+    w_report 'ERROR: ', $self->cfg->actual_src,
+             ': destination root directory not set.';
+    $rc = 0;
+  }
+
+  # Inherit destinations
+  # ----------------------------------------------------------------------------
+  for my $use (@{ $self->inherit }) {
+    push @{ $self->dest->inherit }, (@{ $use->dest->inherit }, $use->dest);
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_header (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the header setting in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_header {
+  my ($self, $cfg_lines) = @_;
+
+  # Set header lines as "parsed"
+  map {$_->parsed (1)} grep {$_->slabel_starts_with_cfg ('CFGFILE')} @$cfg_lines;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_inherit (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the inherit setting in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_inherit {
+  my ($self, $cfg_lines) = @_;
+
+  # USE declaration
+  # ----------------------------------------------------------------------------
+  my @lines = grep {$_->slabel_starts_with_cfg ('USE')} @$cfg_lines;
+
+  # Check for cyclic dependency
+  if (@lines and grep {$_ eq $self->cfg->actual_src} @{ $self->inherited }) {
+    # Error if current configuration file is in its own inheritance hierarchy
+    w_report 'ERROR: ', $self->cfg->actual_src, ': attempt to inherit itself.';
+    $_->error ($_->label . ': ignored due to cyclic dependency.') for (@lines);
+    return 0;
+  }
+
+  my $rc = 1;
+
+  for my $line (@lines) {
+    # Invoke new instance of the current class
+    my $use = ref ($self)->new;
+
+    # Set configuration file, inheritance hierarchy
+    # and attempt to parse the configuration
+    $use->cfg->src  (&expand_tilde ($line->value));
+    $use->inherited ([$self->cfg->actual_src, @{ $self->inherited }]);
+    $use->parse_cfg;
+
+    # Add to list of inherit configurations
+    push @{ $self->inherit }, $use;
+
+    $line->parsed (1);
+  }
+
+  # Check locks in inherited destination
+  # ----------------------------------------------------------------------------
+  for my $use (@{ $self->inherit }) {
+    $rc = 0 unless $use->check_lock;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   This method returns the configuration lines of this object.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+
+  my @inherited_dests = map {
+    Fcm::CfgLine->new (
+      label => $self->cfglabel ('USE'), value => $_->dest->rootdir
+    );
+  } @{ $self->inherit };
+
+  return (
+    Fcm::CfgLine::comment_block ('File header'),
+    Fcm::CfgLine->new (
+      label => $self->cfglabel ('CFGFILE') . $Fcm::Config::DELIMITER . 'TYPE',
+      value => $self->type,
+    ),
+    Fcm::CfgLine->new (
+      label => $self->cfglabel ('CFGFILE') . $Fcm::Config::DELIMITER . 'VERSION',
+      value => '1.0',
+    ),
+    Fcm::CfgLine->new (),
+
+    @inherited_dests,
+
+    Fcm::CfgLine::comment_block ('Destination'),
+    ($self->dest->to_cfglines()),
+  );
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Dest.pm
===================================================================
--- vendors/FCM/lib/Fcm/Dest.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Dest.pm	(revision 9621)
@@ -0,0 +1,887 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Dest
+#
+# DESCRIPTION
+#   This class contains methods to set up a destination location of an FCM
+#   extract/build.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use warnings;
+use strict;
+
+package Fcm::Dest;
+use base qw{Fcm::Base};
+
+use Carp             qw{croak}                          ;
+use Cwd              qw{cwd}                            ;
+use Fcm::CfgLine                                        ;
+use Fcm::Timer       qw{timestamp_command}              ;
+use Fcm::Util        qw{run_command touch_file w_report};
+use File::Basename   qw{basename dirname}               ;
+use File::Find       qw{find}                           ;
+use File::Path       qw{mkpath rmtree}                  ;
+use File::Spec                                          ;
+use Sys::Hostname    qw{hostname}                       ;
+use Text::ParseWords qw{shellwords}                     ;
+
+# Useful variables
+# ------------------------------------------------------------------------------
+# List of configuration files
+our @cfgfiles = (
+  'bldcfg',     # default location of the build configuration file
+  'extcfg',     # default location of the extract configuration file
+);
+
+# List of cache and configuration files, according to the dest type
+our @cfgfiles_type = (
+  'cache',     # default location of the cache file
+  'cfg',       # default location of the configuration file
+  'parsedcfg', # default location of the as-parsed configuration file
+);
+
+# List of lock files
+our @lockfiles = (
+  'bldlock',    # the build lock file
+  'extlock',    # the extract lock file
+);
+
+# List of misc files
+our @miscfiles_bld = (
+  'bldrunenvsh', # the build run environment shell script
+  'bldmakefile', # the build Makefile
+);
+
+# List of sub-directories created by extract
+our @subdirs_ext = (
+  'cfgdir',     # sub-directory for configuration files
+  'srcdir',     # sub-directory for source tree
+);
+
+# List of sub-directories that can be archived by "tar" at end of build
+our @subdirs_tar = (
+  'donedir',    # sub-directory for "done" files
+  'flagsdir',   # sub-directory for "flags" files
+  'incdir',     # sub-directory for include files
+  'ppsrcdir',   # sub-directory for pre-process source tree
+  'objdir',     # sub-directory for object files
+);
+
+# List of sub-directories created by build
+our @subdirs_bld = (
+  'bindir',     # sub-directory for executables
+  'etcdir',     # sub-directory for miscellaneous files
+  'libdir',     # sub-directory for object libraries
+  'tmpdir',     # sub-directory for temporary build files
+  @subdirs_tar, # -see above-
+);
+
+# List of sub-directories under rootdir
+our @subdirs = (
+  'cachedir',   # sub-directory for caches
+  @subdirs_ext, # -see above-
+  @subdirs_bld, # -see above-
+);
+
+# List of inherited search paths
+# "rootdir" + all @subdirs, with "XXXdir" replaced with "XXXpath"
+our @paths = (
+    'rootpath',
+    (map {my $key = $_; $key =~ s{dir\z}{path}msx; $key} @subdirs),
+);
+
+# List of properties and their default values.
+my %PROP_OF = (
+  # the original destination (if current destination is a mirror)
+  'dest0'                => undef,
+  # list of inherited Fcm::Dest objects
+  'inherit'              => [],
+  # remote login name
+  'logname'              => scalar(getpwuid($<)),
+  # lock file
+  'lockfile'             => undef,
+  # remote machine
+  'machine'              => hostname(),
+  # mirror command to use
+  'mirror_cmd'           => 'rsync',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsh_mkdir_rsh'        => 'ssh',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsh_mkdir_rshflags'   => '-n -oBatchMode=yes',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsh_mkdir_mkdir'      => 'mkdir',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsh_mkdir_mkdirflags' => '-p',
+  # (for rsync) remote mkdir, the remote shell command
+  'rsync'                => 'rsync',
+  # (for rsync) remote mkdir, the remote shell command flags
+  'rsyncflags'           => q{-a --exclude='.*' --delete-excluded}
+                            . q{ --timeout=900 --rsh='ssh -oBatchMode=yes'},
+  # destination root directory
+  'rootdir'              => undef,
+  # destination type, "bld" (default) or "ext"
+  'type'                 => 'bld',
+);
+# Hook for property setter
+my %PROP_HOOK_OF = (
+  'inherit' => \&_reset_inherit,
+  'rootdir' => \&_reset_rootdir,
+);
+
+# Mirror implementations
+my %MIRROR_IMPL_OF = (
+  rdist => \&_mirror_with_rdist,
+  rsync => \&_mirror_with_rsync,
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Dest->new(%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Dest class. See above for
+#   allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my ($class, %args) = @_;
+  my $self = bless(Fcm::Base->new(%args), $class);
+  while (my ($key, $value) = each(%args)) {
+    $key = lc($key);
+    if (exists($PROP_OF{$key})) {
+        $self->{$key} = $value;
+    }
+  }
+  for my $key (@subdirs, @paths, @lockfiles, @cfgfiles) {
+    $self->{$key} = undef;
+  }
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $self->DESTROY;
+#
+# DESCRIPTION
+#   This method is called automatically when the Fcm::Dest object is
+#   destroyed.
+# ------------------------------------------------------------------------------
+
+sub DESTROY {
+  my $self = shift;
+
+  # Remove the lockfile if it is set
+  unlink $self->lockfile if $self->lockfile and -w $self->lockfile;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in %PROP_OF.
+# ------------------------------------------------------------------------------
+
+while (my ($key, $default) = each(%PROP_OF)) {
+  no strict 'refs';
+  *{$key} = sub {
+    my $self = shift();
+    # Set property to specified value
+    if (@_) {
+      $self->{$key} = $_[0];
+      if (exists($PROP_HOOK_OF{$key})) {
+        $PROP_HOOK_OF{$key}->($self, $key);
+      }
+    }
+    # Sets default where possible
+    if (!defined($self->{$key})) {
+      $self->{$key} = $default;
+    }
+    return $self->{$key};
+  };
+}
+
+# Remote shell property: deprecated.
+sub remote_shell {
+  my $self = shift();
+  $self->rsh_mkdir_rsh(@_);
+}
+
+# Resets properties associated with root directory.
+sub _reset_rootdir {
+  my $self = shift();
+  for my $key (@cfgfiles, @lockfiles, @miscfiles_bld, @subdirs) {
+    $self->{$key} = undef;
+  }
+}
+
+# Reset properties associated with inherited paths.
+sub _reset_inherit {
+  my $self = shift();
+  for my $key (@paths) {
+    $self->{$key} = undef;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns X, where X is a location derived from rootdir, and can
+#   be one of:
+#     bindir, bldcfg, blddir, bldlock, bldrunenv, cache, cachedir, cfg, cfgdir,
+#     donedir, etcdir, extcfg, extlock, flagsdir, incdir, libdir, parsedcfg,
+#     ppsrcdir, objdir, or tmpdir.
+#
+#   Details of these properties are explained earlier.
+# ------------------------------------------------------------------------------
+
+for my $name (@cfgfiles, @cfgfiles_type, @lockfiles, @miscfiles_bld, @subdirs) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # If variable not set, derive it from rootdir
+    if ($self->rootdir and not defined $self->{$name}) {
+      if ($name eq 'cache') {
+        # Cache file under root/.cache
+        $self->{$name} =  File::Spec->catfile (
+          $self->cachedir, $self->setting ('CACHE'),
+        );
+
+      } elsif ($name eq 'cfg') {
+        # Configuration file of current type
+        my $method = $self->type . 'cfg';
+        $self->{$name} = $self->$method;
+
+      } elsif (grep {$name eq $_} @cfgfiles) {
+        # Configuration files under the root/cfg
+        (my $label = uc ($name)) =~ s/CFG//;
+        $self->{$name} = File::Spec->catfile (
+          $self->cfgdir, $self->setting ('CFG_NAME', $label),
+        );
+
+      } elsif (grep {$name eq $_} @lockfiles) {
+        # Lock file
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir, $self->setting ('LOCK', uc ($name)),
+        );
+
+      } elsif (grep {$name eq $_} @miscfiles_bld) {
+        # Misc file
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir, $self->setting ('BLD_MISC', uc ($name)),
+        );
+
+      } elsif ($name eq 'parsedcfg') {
+        # As-parsed configuration file of current type
+        $self->{$name} = File::Spec->catfile (
+          dirname ($self->cfg),
+          $self->setting (qw/CFG_NAME PARSED/) . basename ($self->cfg),
+        )
+
+      } elsif (grep {$name eq $_} @subdirs) {
+        # Sub-directories under the root
+        (my $label = uc ($name)) =~ s/DIR//;
+        $self->{$name} = File::Spec->catfile (
+          $self->rootdir,
+          $self->setting ('DIR', $label),
+          ($name eq 'cachedir' ? '.' . $self->type : ()),
+        );
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#
+# DESCRIPTION
+#   This method returns X, an array containing the search path of a destination
+#   directory, which can be one of:
+#     binpath, bldpath, cachepath, cfgpath, donepath, etcpath, flagspath,
+#     incpath, libpath, ppsrcpath, objpath, rootpath, srcpath, or tmppath,
+#
+#   Details of these properties are explained earlier.
+# ------------------------------------------------------------------------------
+
+for my $name (@paths) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    (my $dir = $name) =~ s/path/dir/;
+
+    if ($self->$dir and not defined $self->{$name}) {
+      my @path = ();
+
+      # Recursively inherit the search path
+      for my $d (@{ $self->inherit }) {
+        unshift @path, $d->$dir;
+      }
+
+      # Place the path of the current build in the front
+      unshift @path, $self->$dir;
+
+      $self->{$name} = \@path;
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->archive ();
+#
+# DESCRIPTION
+#   This method creates TAR archives for selected sub-directories.
+# ------------------------------------------------------------------------------
+
+sub archive {
+  my $self = shift;
+
+  # Save current directory
+  my $cwd = cwd ();
+
+  my $tar      = $self->setting (qw/OUTFILE_EXT TAR/);
+  my $verbose  = $self->verbose;
+
+  for my $name (@subdirs_tar) {
+    my $dir = $self->$name;
+
+    # Ignore unless sub-directory exists
+    next unless -d $dir;
+
+    # Change to container directory
+    my $base = basename ($dir);
+    print 'cd ', dirname ($dir), "\n" if $verbose > 2;
+    chdir dirname ($dir);
+
+    # Run "tar" command
+    my $rc = &run_command (
+      [qw/tar -czf/, $base . $tar, $base],
+      PRINT => $verbose > 1, ERROR => 'warn',
+    );
+
+    # Remove sub-directory
+    &run_command ([qw/rm -rf/, $base], PRINT => $verbose > 1) if not $rc;
+  }
+
+  # Change back to "current" directory
+  print 'cd ', $cwd, "\n" if $verbose > 2;
+  chdir $cwd;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $authority = $obj->authority();
+#
+# DESCRIPTION
+#   Returns LOGNAME@MACHINE for this destination if LOGNAME is defined and not
+#   the same as the user ID of the current process. Returns MACHINE if LOGNAME
+#   is the same as the user ID of the current process, but MACHINE is not the
+#   same as the current hostname. Returns an empty string if LOGNAME and
+#   MACHINE are not defined or are the same as in the current process.
+# ------------------------------------------------------------------------------
+
+sub authority {
+  my $self = shift;
+  my $return = '';
+
+  if ($self->logname ne $self->config->user_id) {
+    $return = $self->logname . '@' . $self->machine;
+
+  } elsif ($self->machine ne &hostname()) {
+    $return = $self->machine;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->clean([ITEM => <list>,] [MODE => 'ALL|CONTENT|EMPTY',]);
+#
+# DESCRIPTION
+#   This method removes files/directories from the destination. If ITEM is set,
+#   it must be a reference to a list of method names for files/directories to
+#   be removed. Otherwise, the list is determined by the destination type. If
+#   MODE is ALL, all directories/files created by the extract/build are
+#   removed. If MODE is CONTENT, only contents within sub-directories are
+#   removed. If MODE is EMPTY (default), only empty sub-directories are
+#   removed.
+# ------------------------------------------------------------------------------
+
+sub clean {
+  my ($self, %args) = @_;
+  my $mode = exists $args{MODE} ? $args{MODE} : 'EMPTY';
+  my $rc = 1;
+  my @names
+    = $args{ITEM}            ? @{$args{ITEM}}
+    : $self->type() eq 'ext' ? ('cachedir', @subdirs_ext)
+    :                          ('cachedir', @subdirs_bld, @miscfiles_bld)
+    ;
+  my @items;
+  if ($mode eq 'CONTENT') {
+    for my $name (@names) {
+      my $item = $self->$name();
+      push(@items, _directory_contents($item));
+    }
+  }
+  else {
+    for my $name (@names) {
+      my $item = $self->$name();
+      if ($mode eq 'ALL' || -d $item && !_directory_contents($item)) {
+        push(@items, $item);
+      }
+    }
+  }
+  for my $item (@items) {
+    if ($self->verbose() >= 2) {
+      printf("%s: remove\n", $item);
+    }
+    eval {rmtree($item)};
+    if ($@) {
+      w_report($@);
+      $rc = 0;
+    }
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create ([DIR => <dir-list>,]);
+#
+# DESCRIPTION
+#   This method creates the directories of a destination. If DIR is set, it
+#   must be a reference to a list of sub-directories to be created.  Otherwise,
+#   the sub-directory list is determined by the destination type. It returns
+#   true if the destination is created or if it exists and is writable.
+# ------------------------------------------------------------------------------
+
+sub create {
+  my ($self, %args) = @_;
+
+  my $rc = 1;
+
+  my @dirs;
+  if (exists $args{DIR} and $args{DIR}) {
+    # Create only selected sub-directories
+    @dirs = @{ $args{DIR} };
+
+  } else {
+    # Create rootdir, cachedir and read-write sub-directories for extract/build
+    @dirs = (
+      qw/rootdir cachedir/,
+      ($self->type eq 'ext' ? @subdirs_ext : @subdirs_bld),
+    );
+  }
+
+  for my $name (@dirs) {
+    my $dir = $self->$name;
+
+    # Create directory if it does not already exist
+    if (not -d $dir) {
+      print 'Make directory: ', $dir, "\n" if $self->verbose > 1;
+      mkpath $dir;
+    }
+
+    # Check whether directory exists and is writable
+    unless (-d $dir and -w $dir) {
+      w_report 'ERROR: ', $dir, ': cannot write to destination.';
+      $rc = 0;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create_bldrunenvsh ();
+#
+# DESCRIPTION
+#   This method creates the runtime environment script for the build.
+# ------------------------------------------------------------------------------
+
+sub create_bldrunenvsh {
+  my $self = shift;
+
+  # Path to executable files and directory for misc files
+  my @bin_paths = grep {_directory_contents($_)} @{$self->binpath()};
+  my $bin_dir = -d $self->bindir() ? $self->bindir() : undef;
+  my $etc_dir = _directory_contents($self->etcdir()) ? $self->etcdir() : undef;
+
+  # Create a runtime environment script if necessary
+  if (@bin_paths || $etc_dir) {
+    my $path = $self->bldrunenvsh();
+    open(my $handle, '>', $path) || croak("$path: cannot open ($!)\n");
+    printf($handle "#!%s\n", $self->setting(qw/TOOL SHELL/));
+    if (@bin_paths) {
+      printf($handle "PATH=%s:\$PATH\n", join(':', @bin_paths));
+      print($handle "export PATH\n");
+    }
+    if ($etc_dir) {
+      printf($handle "FCM_ETCDIR=%s\n", $etc_dir);
+      print($handle "export FCM_ETCDIR\n");
+    }
+    close($handle) || croak("$path: cannot close ($!)\n");
+
+    # Create symbolic links fcm_env.ksh and bin/fcm_env.ksh for backward
+    # compatibility
+    my $FCM_ENV_KSH = 'fcm_env.ksh';
+    for my $link (
+      File::Spec->catfile($self->rootdir, $FCM_ENV_KSH),
+      ($bin_dir ? File::Spec->catfile($bin_dir, $FCM_ENV_KSH) : ()),
+    ) {
+      if (-l $link && readlink($link) ne $path || -e $link) {
+        unlink($link);
+      }
+      if (!-l $link) {
+        symlink($path, $link) || croak("$link: cannot create symbolic link\n");
+      }
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->dearchive ();
+#
+# DESCRIPTION
+#   This method extracts from TAR archives for selected sub-directories.
+# ------------------------------------------------------------------------------
+
+sub dearchive {
+  my $self = shift;
+
+  my $tar     = $self->setting (qw/OUTFILE_EXT TAR/);
+  my $verbose = $self->verbose;
+
+  # Extract archives if necessary
+  for my $name (@subdirs_tar) {
+    my $tar_file = $self->$name . $tar;
+
+    # Check whether tar archive exists for the named sub-directory
+    next unless -f $tar_file;
+
+    # If so, extract the archive and remove it afterwards
+    &run_command ([qw/tar -xzf/, $tar_file], PRINT => $verbose > 1);
+    &run_command ([qw/rm -f/, $tar_file], PRINT => $verbose > 1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $name = $obj->get_pkgname_of_path ($path);
+#
+# DESCRIPTION
+#   This method returns the package name of $path if $path is in (a relative
+#   path of) $self->srcdir, or undef otherwise.
+# ------------------------------------------------------------------------------
+
+sub get_pkgname_of_path {
+  my ($self, $path) = @_;
+
+  my $relpath = File::Spec->abs2rel ($path, $self->srcdir);
+  my $name = $relpath ? [File::Spec->splitdir ($relpath)] : undef;
+
+  return $name;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %src = $obj->get_source_files ();
+#
+# DESCRIPTION
+#   This method returns a hash (keys = package names, values = file names)
+#   under $self->srcdir.
+# ------------------------------------------------------------------------------
+
+sub get_source_files {
+  my $self = shift;
+
+  my %src;
+  if ($self->srcdir and -d $self->srcdir) {
+    &find (sub {
+      return if /^\./;                    # ignore system/hidden file
+      return if -d $File::Find::name;     # ignore directory
+      return if not -r $File::Find::name; # ignore unreadable files
+
+      my $name = join (
+        '__', @{ $self->get_pkgname_of_path ($File::Find::name) },
+      );
+      $src{$name} = $File::Find::name;
+    }, $self->srcdir);
+  }
+
+  return \%src;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->mirror (\@items);
+#
+# DESCRIPTION
+#   This method mirrors @items (list of method names for directories or files)
+#   from $dest0 (which must be an instance of Fcm::Dest for a local
+#   destination) to this destination.
+# ------------------------------------------------------------------------------
+
+sub mirror {
+  my ($self, $items_ref) = @_;
+  if ($self->authority() || $self->dest0()->rootdir() ne $self->rootdir()) {
+    # Diagnostic
+    if ($self->verbose()) {
+      printf(
+        "Destination: %s\n",
+        ($self->authority() ? $self->authority() . q{:} : q{}) . $self->rootdir()
+      );
+    }
+    if ($MIRROR_IMPL_OF{$self->mirror_cmd()}) {
+      $MIRROR_IMPL_OF{$self->mirror_cmd()}->($self, $self->dest0(), $items_ref);
+    }
+    else {
+      # Unknown mirroring tool
+      w_report($self->mirror_cmd, ': unknown mirroring tool, abort.');
+      return 0;
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_mirror_with_rdist ($dest0, \@items);
+#
+# DESCRIPTION
+#   This internal method implements $self->mirror with "rdist".
+# ------------------------------------------------------------------------------
+
+sub _mirror_with_rdist {
+  my ($self, $dest0, $items) = @_;
+
+  my $rhost = $self->authority ? $self->authority : &hostname();
+
+  # Print distfile content to temporary file
+  my @distfile = ();
+  for my $label (@$items) {
+    push @distfile, '( ' . $dest0->$label . ' ) -> ' . $rhost . "\n";
+    push @distfile, '  install ' . $self->$label . ';' . "\n";
+  }
+
+  # Set up mirroring command (use "rdist" at the moment)
+  my $command = 'rdist -R';
+  $command   .= ' -q' unless $self->verbose > 1;
+  $command   .= ' -f - 1>/dev/null';
+
+  # Diagnostic
+  my $croak = 'Cannot execute "' . $command . '"';
+  if ($self->verbose > 2) {
+    print timestamp_command ($command, 'Start');
+    print '  ', $_ for (@distfile);
+  }
+
+  # Execute the mirroring command
+  open COMMAND, '|-', $command or croak $croak, ' (', $!, '), abort';
+  for my $line (@distfile) {
+    print COMMAND $line;
+  }
+  close COMMAND or croak $croak, ' (', $?, '), abort';
+
+  # Diagnostic
+  print timestamp_command ($command, 'End  ') if $self->verbose > 2;
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->_mirror_with_rsync($dest0, \@items);
+#
+# DESCRIPTION
+#   This internal method implements $self->mirror() with "rsync".
+# ------------------------------------------------------------------------------
+
+sub _mirror_with_rsync {
+  my ($self, $dest0, $items_ref) = @_;
+  my @rsh_mkdir;
+  if ($self->authority()) {
+    @rsh_mkdir = (
+        $self->rsh_mkdir_rsh(),
+        shellwords($self->rsh_mkdir_rshflags()),
+        $self->authority(),
+        $self->rsh_mkdir_mkdir(),
+        shellwords($self->rsh_mkdir_mkdirflags()),
+    );
+  }
+  my @rsync = ($self->rsync(), shellwords($self->rsyncflags()));
+  my @rsync_verbose = ($self->verbose() > 2 ? '-v' : ());
+  my $auth = $self->authority() ? $self->authority() . q{:} : q{};
+  for my $item (@{$items_ref}) {
+    # Create container directory, as rsync does not do it automatically
+    my $dir = dirname($self->$item());
+    if (@rsh_mkdir) {
+      run_command([@rsh_mkdir, $dir], TIME => $self->verbose() > 2);
+    }
+    else {
+      mkpath($dir);
+    }
+    run_command(
+      [@rsync, @rsync_verbose, $dest0->$item(), $auth . $dir],
+      TIME => $self->verbose > 2,
+    );
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->set_lock ();
+#
+# DESCRIPTION
+#   This method sets a lock in the current destination.
+# ------------------------------------------------------------------------------
+
+sub set_lock {
+  my $self = shift;
+
+  $self->lockfile ();
+
+  if ($self->type eq 'ext' and not $self->dest0) {
+    # Only set an extract lock for the local destination
+    $self->lockfile ($self->extlock);
+
+  } elsif ($self->type eq 'bld') {
+    # Set a build lock
+    $self->lockfile ($self->bldlock);
+  }
+
+  return &touch_file ($self->lockfile) if $self->lockfile;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ([$index]);
+#
+# DESCRIPTION
+#   This method returns a list of configuration lines for the current
+#   destination. If it is set, $index is the index number of the current
+#   destination.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self, $index) = @_;
+
+  my $PREFIX = $self->cfglabel($self->dest0() ? 'RDEST' : 'DEST');
+  my $SUFFIX = ($index ? $Fcm::Config::DELIMITER . $index : q{});
+
+  my @return = (
+    Fcm::CfgLine->new(label => $PREFIX . $SUFFIX, value => $self->rootdir()),
+  );
+  if ($self->dest0()) {
+    for my $name (qw{
+      logname
+      machine
+      mirror_cmd
+      rsh_mkdir_rsh
+      rsh_mkdir_rshflags
+      rsh_mkdir_mkdir
+      rsh_mkdir_mkdirflags
+      rsync
+      rsyncflags
+    }) {
+      if ($self->{$name} && $self->{$name} ne $PROP_OF{$name}) { # not default
+        push(
+          @return,
+          Fcm::CfgLine->new(
+            label => $PREFIX . $Fcm::Config::DELIMITER . uc($name) . $SUFFIX,
+            value => $self->{$name},
+          ),
+        );
+      }
+    }
+  }
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = $obj->write_rules ();
+#
+# DESCRIPTION
+#   This method returns a string containing Makefile variable declarations for
+#   directories and search paths in this destination.
+# ------------------------------------------------------------------------------
+
+sub write_rules {
+  my $self   = shift;
+  my $return = '';
+
+  # FCM_*DIR*
+  for my $i (0 .. @{ $self->inherit }) {
+    for my $name (@paths) {
+      (my $label = $name) =~ s/path$/dir/;
+      my $dir = $name eq 'rootpath' ? $self->$name->[$i] : File::Spec->catfile (
+        '$(FCM_ROOTDIR' . ($i ? $i : '') . ')',
+        File::Spec->abs2rel ($self->$name->[$i], $self->rootpath->[$i]),
+      );
+
+      $return .= ($i ? '' : 'export ') . 'FCM_' . uc ($label) . ($i ? $i : '') .
+                 ' := ' . $dir . "\n";
+    }
+  }
+
+  # FCM_*PATH
+  for my $name (@paths) {
+    (my $label = $name) =~ s/path$/dir/;
+
+    $return .= 'export FCM_' . uc ($name) . ' := ';
+    for my $i (0 .. @{ $self->$name } - 1) {
+      $return .= ($i ? ':' : '') . '$(FCM_' . uc ($label) . ($i ? $i : '') . ')';
+    }
+    $return .= "\n";
+  }
+
+  $return .= "\n";
+
+  return $return;
+}
+
+# Returns contents in directory.
+sub _directory_contents {
+  my $path = shift();
+  if (!-d $path) {
+    return;
+  }
+  opendir(my $handle, $path) || croak("$path: cannot open directory ($!)\n");
+  my @items = grep {$_ ne q{.} && $_ ne q{..}} readdir($handle);
+  closedir($handle);
+  map {File::Spec->catfile($path . $_)} @items;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Exception.pm
===================================================================
--- vendors/FCM/lib/Fcm/Exception.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Exception.pm	(revision 9621)
@@ -0,0 +1,95 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Exception;
+use overload (q{""} => \&as_string);
+
+use Scalar::Util qw{blessed};
+
+# ------------------------------------------------------------------------------
+# Returns true if $e is a blessed instance of this class.
+sub caught {
+    my ($class, $e) = @_;
+    return (blessed($e) && $e->isa($class));
+}
+
+# ------------------------------------------------------------------------------
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless(
+        {message => q{unknown problem}, ($args_ref ? %{$args_ref} : ())},
+        $class,
+    );
+}
+
+# ------------------------------------------------------------------------------
+# Returns a string representation of this exception
+sub as_string {
+    my ($self) = @_;
+    return sprintf("%s: %s\n", blessed($self), $self->get_message());
+}
+
+# ------------------------------------------------------------------------------
+# Returns the message of this exception
+sub get_message {
+    my ($self) = @_;
+    return $self->{message};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Exception
+
+=head1 SYNOPSIS
+
+    use Fcm::Exception;
+    eval {
+        croak(Fcm::Exception->new({message => $message}));
+    };
+    if ($@) {
+        if (Fcm::Exception->caught($@)) {
+            print({STDERR} $@);
+        }
+    }
+
+=head1 DESCRIPTION
+
+This exception is raised when there is a generic problem in FCM.
+
+=head1 METHODS
+
+=over 4
+
+=item $class->caught($e)
+
+Returns true if $e is a blessed instance of this class.
+
+=item $class->new({message=E<gt>$message})
+
+Returns a new instance of this exception. Its first argument must be a
+reference to a hash containing the detailed I<message> of the exception.
+
+=item $e->as_string()
+
+Returns a string representation of this exception.
+
+=item $e->get_message()
+
+Returns the detailed message of this exception.
+
+=back
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Extract.pm
===================================================================
--- vendors/FCM/lib/Fcm/Extract.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Extract.pm	(revision 9621)
@@ -0,0 +1,1118 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Extract
+#
+# DESCRIPTION
+#   This is the top level class for the FCM extract system.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Extract;
+@ISA = qw(Fcm::ConfigSystem);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Standard modules
+use File::Path;
+use File::Spec;
+
+# FCM component modules
+use Fcm::CfgFile;
+use Fcm::CfgLine;
+use Fcm::Config;
+use Fcm::ConfigSystem;
+use Fcm::Dest;
+use Fcm::ExtractFile;
+use Fcm::ExtractSrc;
+use Fcm::Keyword;
+use Fcm::ReposBranch;
+use Fcm::SrcDirLayer;
+use Fcm::Util;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+ 'bdeclare', # list of build declarations
+ 'branches', # list of repository branches
+ 'conflict', # conflict mode
+ 'rdest'   , # remote destination information
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+ 'srcdirs' , # list of source directory extract info
+ 'files',    # list of files processed key=pkgname, value=Fcm::ExtractFile
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::Extract->new;
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::Extract class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::ConfigSystem->new (%args);
+
+  $self->{$_} = undef for (@scalar_properties);
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+
+  # List of sub-methods for parse_cfg
+  push @{ $self->cfg_methods }, (qw/rdest bld conflict project/);
+
+  # System type
+  $self->type ('ext');
+
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'bdeclare' or $name eq 'branches') {
+        # Reference to an array
+        $self->{$name} = [];
+
+      } elsif ($name eq 'rdest') {
+        # New extract destination local/remote
+        $self->{$name} = Fcm::Dest->new (DEST0 => $self->dest(), TYPE => 'ext');
+
+      } elsif ($name eq 'conflict') {
+        # Conflict mode, default to "merge"
+        $self->{$name} = 'merge';
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->check_lock_is_allowed ($lock);
+#
+# DESCRIPTION
+#   This method returns true if it is OK for $lock to exist in the destination.
+# ------------------------------------------------------------------------------
+
+sub check_lock_is_allowed {
+  my ($self, $lock) = @_;
+
+  # Allow existence of build lock in inherited extract
+  return ($lock eq $self->dest->bldlock and @{ $self->inherited });
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_extract ();
+#
+# DESCRIPTION
+#   This method invokes the extract stage of the extract system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_extract {
+  my $self = shift;
+
+  my $rc = 1;
+
+  my @methods = (
+    'expand_cfg',       # expand URL, revision keywords, relative path, etc
+    'create_dir_stack', # analyse the branches to create an extract sequence
+    'extract_src',      # use the sequence to extract source to destination
+    'write_cfg',        # generate final configuration file
+    'write_cfg_bld',    # generate build configuration file
+  );
+
+  for my $method (@methods) {
+    $rc = $self->$method if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_mirror ();
+#
+# DESCRIPTION
+#   This method invokes the mirror stage of the extract system. It returns
+#   true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_mirror {
+  my $self = shift;
+  return $self->rdest->mirror ([qw/bldcfg extcfg srcdir/]);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->invoke_system ();
+#
+# DESCRIPTION
+#   This method invokes the extract system. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub invoke_system {
+  my $self = shift;
+
+  my $rc = 1;
+  
+  $rc = $self->invoke_stage ('Extract', 'invoke_extract');
+  $rc = $self->invoke_stage ('Mirror', 'invoke_mirror')
+    if $rc and $self->rdest->rootdir;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_rdest(\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the remote destination settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_rdest {
+  my ($self, $cfg_lines_ref) = @_;
+
+  # RDEST declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg('RDEST')} @{$cfg_lines_ref}) {
+    my ($d, $method) = map {lc($_)} $line->slabel_fields();
+    $method ||= 'rootdir';
+    if ($self->rdest()->can($method)) {
+      $self->rdest()->$method(expand_tilde($line->value()));
+      $line->parsed(1);
+    }
+  }
+
+  # MIRROR declaration, deprecated = RDEST::MIRROR_CMD
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg('MIRROR')} @{$cfg_lines_ref}) {
+    $self->rdest()->mirror_cmd($line->value());
+    $line->parsed(1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_bld (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the build configurations in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_bld {
+  my ($self, $cfg_lines) = @_;
+
+  # BLD declarations
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('BDECLARE')} @$cfg_lines) {
+    # Remove BLD from label
+    my @words = $line->slabel_fields;
+
+    # Check that a declaration follows BLD
+    next if @words <= 1;
+
+    push @{ $self->bdeclare }, Fcm::CfgLine->new (
+      LABEL  => join ($Fcm::Config::DELIMITER, @words),
+      PREFIX => $self->cfglabel ('BDECLARE'),
+      VALUE  => $line->value,
+    );
+    $line->parsed (1);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_conflict (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the conflict settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_conflict {
+  my ($self, $cfg_lines) = @_;
+
+  # Deprecated: Override mode setting
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('OVERRIDE')} @$cfg_lines) {
+    next if ($line->slabel_fields) > 1;
+    $self->conflict ($line->bvalue ? 'override' : 'fail');
+    $line->parsed (1);
+    $line->warning($line->slabel . ' is deprecated. Use ' .
+                   $line->cfglabel('CONFLICT') . ' override|merge|fail.');
+  }
+
+  # Conflict mode setting
+  # ----------------------------------------------------------------------------
+  my @conflict_modes = qw/fail merge override/;
+  my $conflict_modes_pattern = join ('|', @conflict_modes);
+  for my $line (grep {$_->slabel_starts_with_cfg ('CONFLICT')} @$cfg_lines) {
+    if ($line->value =~ /$conflict_modes_pattern/i) {
+      $self->conflict (lc ($line->value));
+      $line->parsed (1);
+
+    } elsif ($line->value =~ /^[012]$/) {
+      $self->conflict ($conflict_modes[$line->value]);
+      $line->parsed (1);
+
+    } else {
+      $line->error ($line->value, ': invalid value');
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->parse_cfg_project (\@cfg_lines);
+#
+# DESCRIPTION
+#   This method parses the project settings in the @cfg_lines.
+# ------------------------------------------------------------------------------
+
+sub parse_cfg_project {
+  my ($self, $cfg_lines) = @_;
+
+  # Flag to indicate that a declared branch revision must match with its changed
+  # revision
+  # ----------------------------------------------------------------------------
+  for my $line (grep {$_->slabel_starts_with_cfg ('REVMATCH')} @$cfg_lines) {
+    next if ($line->slabel_fields) > 1;
+    $self->setting ([qw/EXT_REVMATCH/], $line->bvalue);
+    $line->parsed (1);
+  }
+
+  # Repository, revision and source directories
+  # ----------------------------------------------------------------------------
+  for my $name (qw/repos revision dirs expdirs/) {
+    my @lines = grep {
+      $_->slabel_starts_with_cfg (uc ($name)) or
+      $name eq 'revision' and $_->slabel_starts_with_cfg ('VERSION');
+    } @$cfg_lines;
+    for my $line (@lines) {
+      my @names = $line->slabel_fields;
+      shift @names;
+
+      # Detemine package and tag
+      my $tag     = pop @names;
+      my $pckroot = $names[0];
+      my $pck     = join ($Fcm::Config::DELIMITER, @names);
+
+      # Check that $tag and $pckroot are defined
+      next unless $tag and $pckroot;
+
+      # Check if branch already exists.
+      # If so, set $branch to point to existing branch
+      my $branch = undef;
+      for (@{ $self->branches }) {
+        next unless $_->package eq $pckroot and $_->tag eq $tag;
+
+        $branch = $_;
+        last;
+      }
+
+      # Otherwise, create a new branch
+      if (not $branch) {
+        $branch = Fcm::ReposBranch->new (PACKAGE => $pckroot, TAG => $tag,);
+
+        push @{ $self->branches }, $branch;
+      }
+
+      if ($name eq 'repos' or $name eq 'revision') {
+        # Branch location or revision
+        $branch->$name ($line->value);
+
+      } else { # $name eq 'dirs' or $name eq 'expdirs'
+        # Source directory or expandable source directory
+        if ($pck eq $pckroot and $line->value !~ m#^/#) {
+          # Sub-package name not set and source directory quoted as a relative
+          # path, determine package name from path name
+          $pck = join (
+            $Fcm::Config::DELIMITER,
+            ($pckroot, File::Spec->splitdir ($line->value)),
+          );
+        }
+
+        # A "/" is equivalent to the top (empty) package
+        my $value = ($line->value =~ m#^/+$#) ? '' : $line->value;
+        $branch->$name ($pck, $value);
+      }
+
+      $line->parsed (1);
+    }
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_cfg ();
+#
+# DESCRIPTION
+#   This method expands the settings of the extract configuration.
+# ------------------------------------------------------------------------------
+
+sub expand_cfg {
+  my $self = shift;
+
+  my $rc = 1;
+  for my $use (@{ $self->inherit }) {
+    $rc = $use->expand_cfg if $rc;
+  }
+
+  return $rc unless $rc;
+
+  # Establish a set of source directories from the "base repository"
+  my %base_branches = ();
+
+  # Inherit "base" set of source directories from re-used extracts
+  for my $use (@{ $self->inherit }) {
+    my @branches = @{ $use->branches };
+
+    for my $branch (@branches) {
+      my $package              = $branch->package;
+      $base_branches{$package} = $branch unless exists $base_branches{$package};
+    }
+  }
+
+  for my $branch (@{ $self->branches }) {
+    # Expand URL keywords if necessary
+    if ($branch->repos) {
+      my $repos = Fcm::Util::tidy_url(Fcm::Keyword::expand($branch->repos()));
+      $branch->repos ($repos) if $repos ne $branch->repos;
+    }
+
+    # Check that repository type and revision are set
+    if ($branch->repos and &is_url ($branch->repos)) {
+      $branch->type ('svn') unless $branch->type;
+      $branch->revision ('head') unless $branch->revision;
+
+    } else {
+      $branch->type ('user') unless $branch->type;
+      $branch->revision ('user') unless $branch->revision;
+    }
+
+    $rc = $branch->expand_revision if $rc; # Get revision number from keywords
+    $rc = $branch->expand_path     if $rc; # Expand relative path to full path
+    $rc = $branch->expand_all      if $rc; # Search sub-directories
+    last unless $rc;
+
+    my $package = $branch->package;
+
+    if (exists $base_branches{$package}) {
+      # A base branch for this package exists
+
+      # If current branch has no source directory, use the set provided by the
+      # base branch
+      my %dirs = %{ $branch->dirs };
+      $branch->add_base_dirs ($base_branches{$package}) unless keys %dirs;
+
+    } else {
+      # This package does not yet have a base branch, set this branch as base
+      $base_branches{$package} = $branch;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->create_dir_stack ();
+#
+# DESCRIPTION
+#   This method creates a hash of source directories to be processed. If the
+#   flag INHERITED is set to true, the source directories are assumed processed
+#   and extracted.
+# ------------------------------------------------------------------------------
+
+sub create_dir_stack {
+  my $self = shift;
+  my %args = @_;
+
+  # Inherit from USE ext cfg
+  for my $use (@{ $self->inherit }) {
+    $use->create_dir_stack () or return 0;
+    my %use_srcdirs = %{ $use->srcdirs };
+
+    while (my ($key, $value) = each %use_srcdirs) {
+      $self->srcdirs ($key, $value);
+
+      # Re-set destination to current destination
+      my @path = split (/$Fcm::Config::DELIMITER/, $key);
+      $self->srcdirs ($key)->{DEST} = File::Spec->catfile (
+        $self->dest->srcdir, @path,
+      );
+    }
+  }
+
+  # Build stack from current ext cfg
+  for my $branch (@{ $self->branches }) {
+    my %branch_dirs = %{ $branch->dirs };
+
+    for my $dir (keys %branch_dirs) {
+      # Check whether source directory is already in the list
+      if (not $self->srcdirs ($dir)) { # if not, create it
+        $self->srcdirs ($dir, {
+          DEST  => File::Spec->catfile (
+            $self->dest->srcdir, split (/$Fcm::Config::DELIMITER/, $dir)
+          ),
+          STACK => [],
+          FILES => {},
+        });
+      }
+
+      my $stack = $self->srcdirs ($dir)->{STACK}; # copy reference
+
+      # Create a new layer in the input stack
+      my $layer = Fcm::SrcDirLayer->new (
+        NAME      => $dir,
+        PACKAGE   => $branch->package,
+        TAG       => $branch->tag,
+        LOCATION  => $branch->dirs ($dir),
+        REPOSROOT => $branch->repos,
+        REVISION  => $branch->revision,
+        TYPE      => $branch->type,
+        EXTRACTED => @{ $self->inherited }
+                     ? $self->srcdirs ($dir)->{DEST} : undef,
+      );
+
+      # Check whether layer is already in the stack
+      my $exist = grep {
+        $_->location eq $layer->location and $_->revision eq $layer->revision;
+      } @{ $stack };
+
+      if (not $exist) {
+        # If not already exist, put layer into stack
+
+        # Note: user stack always comes last
+        if (! $layer->user and exists $stack->[-1] and $stack->[-1]->user) {
+          my $lastlayer = pop @{ $stack };
+          push @{ $stack }, $layer;
+          $layer = $lastlayer;
+        }
+
+        push @{ $stack }, $layer;
+
+      } elsif ($layer->user) {
+
+        # User layer already exists, overwrite it
+        $stack->[-1] = $layer;
+
+      }
+    }
+  }
+
+  # Use the cache to sort the source directory layer hash
+  return $self->compare_setting (METHOD_LIST => ['sort_dir_stack']);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, \@new_lines) = $self->sort_dir_stack ($old_lines);
+#
+# DESCRIPTION
+#   This method sorts thesource directories hash to be processed.
+# ------------------------------------------------------------------------------
+
+sub sort_dir_stack {
+  my ($self, $old_lines) = @_;
+
+  my $rc = 0;
+
+  my %old = ();
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      $old{$line->label} = $line->value;
+    }
+  }
+
+  my %new;
+
+  # Compare each layer to base layer, discard unnecessary layers
+  DIR: for my $srcdir (keys %{ $self->srcdirs }) {
+    my @stack = ();
+
+    while (my $layer = shift @{ $self->srcdirs ($srcdir)->{STACK} }) {
+      if ($layer->user) {
+        # Local file system branch, check that the declared location exists
+        if (-d $layer->location) {
+          # Local file system branch always takes precedence
+          push @stack, $layer;
+
+        } else {
+          w_report 'ERROR: ', $layer->location, ': declared source directory ',
+                   'does not exists ';
+          $rc = undef;
+          last DIR;
+        }
+
+      } else {
+        my $key = join ($Fcm::Config::DELIMITER, (
+          $srcdir, $layer->location, $layer->revision
+        ));
+
+        unless ($layer->extracted and $layer->commit) {
+          # See if commit revision information is cached
+          if (keys %old and exists $old{$key}) {
+            $layer->commit ($old{$key});
+
+          } else {
+            $layer->get_commit;
+            $rc = 1;
+          }
+
+          # Check source directory for commit revision, if necessary
+          if (not $layer->commit) {
+            w_report 'Error: cannot determine the last changed revision of ',
+                     $layer->location;
+            $rc = undef;
+            last DIR;
+          }
+
+          # Set cache directory for layer
+          my $tag_ver = $layer->tag . '__' . $layer->commit;
+          $layer->cachedir (File::Spec->catfile (
+            $self->dest->cachedir,
+            split (/$Fcm::Config::DELIMITER/, $srcdir),
+            $tag_ver,
+          ));
+        }
+
+        # New line in cache config file
+        $new{$key} = $layer->commit;
+
+        # Push this layer in the stack:
+        # 1. it has a different revision compared to the top layer
+        # 2. it is the top layer (base line code)
+        if (@stack > 0) {
+          push @stack, $layer if $layer->commit != $stack[0]->commit;
+
+        } else {
+          push @stack, $layer;
+        }
+
+      }
+    }
+
+    $self->srcdirs ($srcdir)->{STACK} = \@stack;
+  }
+
+  # Write "commit cache" file
+  my @new_lines;
+  if (defined ($rc)) {
+    for my $key (sort keys %new) {
+      push @new_lines, Fcm::CfgLine->new (label => $key, value => $new{$key});
+    }
+  }
+
+  return ($rc, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->extract_src ();
+#
+# DESCRIPTION
+#   This internal method performs the extract of the source directories and
+#   files if necessary.
+# ------------------------------------------------------------------------------
+
+sub extract_src {
+  my $self = shift;
+  my $rc = 1;
+
+  # Ensure destinations exist and are directories
+  for my $srcdir (values %{ $self->srcdirs }) {
+    last if not $rc;
+    if (-f $srcdir->{DEST}) {
+      w_report $srcdir->{DEST},
+               ': destination exists and is not a directory, abort.';
+      $rc = 0;
+    }
+  }
+
+  # Retrieve previous/record current extract configuration for each file.
+  $rc = $self->compare_setting (
+    CACHEBASE => $self->setting ('CACHE_FILE_SRC'),
+    METHOD_LIST => ['compare_setting_srcfiles'],
+  ) if $rc;
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, \@new_lines) = $self->compare_setting_srcfiles ($old_lines);
+#
+# DESCRIPTION
+#   For each file to be extracted, this method creates an instance of an
+#   Fcm::ExtractFile object. It then compares its file's sources to determine
+#   if they have changed. If so, it will allow the Fcm::ExtractFile to
+#   "re-extract" the file to the destination. Otherwise, it will set
+#   Fcm::ExtractFile->dest_status to a null string to denote an "unchanged"
+#   dest_status.
+#
+# SEE ALSO
+#   Fcm::ConfigSystem->compare_setting.
+# ------------------------------------------------------------------------------
+
+sub compare_setting_srcfiles {
+  my ($self, $old_lines) = @_;
+  my $rc = 1;
+
+  # Retrieve previous extract configuration for each file
+  # ----------------------------------------------------------------------------
+  my %old = ();
+  if ($old_lines) {
+    for my $line (@$old_lines) {
+      $old{$line->label} = $line->value;
+    }
+  }
+
+  # Build up a sequence using a Fcm::ExtractFile object for each file
+  # ----------------------------------------------------------------------------
+  for my $srcdir (values %{ $self->srcdirs }) {
+    my %pkgnames0; # (to be) list of package names in the base layer
+    for my $i (0 .. @{ $srcdir->{STACK} } - 1) {
+      my $layer = $srcdir->{STACK}->[$i];
+      # Update the cache for each layer of the stack if necessary
+      $layer->update_cache unless $layer->extracted or -d $layer->localdir;
+
+      # Get list of files in the cache or local directory
+      my %pkgnames;
+      for my $file (($layer->get_files)) {
+        my $pkgname = join (
+          '/', split (/$Fcm::Config::DELIMITER/, $layer->name), $file
+        );
+        $pkgnames0{$pkgname} = 1 if $i == 0; # store package name in base layer
+        $pkgnames{$pkgname} = 1; # store package name in the current layer
+        if (not $self->files ($pkgname)) {
+          $self->files ($pkgname, Fcm::ExtractFile->new (
+            conflict => $self->conflict,
+            dest     => $self->dest->srcpath,
+            pkgname  => $pkgname,
+          ));
+
+          # Base is empty
+          $self->files ($pkgname)->src->[0] = Fcm::ExtractSrc->new (
+            id      => $layer->tag,
+            pkgname => $pkgname,
+          ) if $i > 0;
+        }
+        my $cache = File::Spec->catfile ($layer->localdir, $file);
+        push @{ $self->files ($pkgname)->src }, Fcm::ExtractSrc->new (
+          cache   => $cache,
+          id      => $layer->tag,
+          pkgname => $pkgname,
+          rev     => ($layer->user ? (stat ($cache))[9] : $layer->commit),
+          uri     => join ('/', $layer->location, $file),
+        );
+      }
+
+      # List of removed files in this layer (relative to base layer)
+      if ($i > 0) {
+        for my $pkgname (keys %pkgnames0) {
+          push @{ $self->files ($pkgname)->src }, Fcm::ExtractSrc->new (
+            id      => $layer->tag,
+            pkgname => $pkgname,
+          ) if not exists $pkgnames{$pkgname}
+        }
+      }
+    }
+  }
+
+  # Compare with old settings
+  # ----------------------------------------------------------------------------
+  my %new = ();
+  for my $key (sort keys %{ $self->files }) {
+    # Set up value for cache
+    my @sources = ();
+    for my $src (@{ $self->files ($key)->src }) {
+      push @sources, (defined ($src->uri) ? ($src->uri . '@' . $src->rev) : '');
+    }
+
+    my $value = join ($Fcm::Config::DELIMITER, @sources);
+
+    # Set Fcm::ExtractFile->dest_status to "unchanged" if value is unchanged
+    $self->files ($key)->dest_status ('')
+      if exists $old{$key} and $old{$key} eq $value;
+
+    # Write current settings
+    $new{$key} = $value;
+  }
+
+  # Delete those that exist in previous extract but not in current
+  # ----------------------------------------------------------------------------
+  for my $key (sort keys %old) {
+    next if exists $new{$key};
+    $self->files ($key, Fcm::ExtractFile->new (
+      dest    => $self->dest->srcpath,
+      pkgname => $key,
+    ));
+  }
+
+  # Extract each file, if necessary
+  # ----------------------------------------------------------------------------
+  for my $key (sort keys %{ $self->files }) {
+    $rc = $self->files ($key)->run if defined ($rc);
+    last if not defined ($rc);
+  }
+
+  # Report status
+  # ----------------------------------------------------------------------------
+  if (defined ($rc) and $self->verbose) {
+    my %src_status_count = ();
+    my %dest_status_count = ();
+    for my $key (sort keys %{ $self->files }) {
+      # Report changes in destination in verbose 1 or above
+      my $dest_status = $self->files ($key)->dest_status;
+      my $src_status = $self->files ($key)->src_status;
+      next unless $self->verbose and $dest_status;
+
+      if ($dest_status and $dest_status ne '?') {
+        if (exists $dest_status_count{$dest_status}) {
+          $dest_status_count{$dest_status}++;
+
+        } else {
+          $dest_status_count{$dest_status} = 1;
+        }
+      }
+
+      if ($src_status and $src_status ne '?') {
+        if (exists $src_status_count{$src_status}) {
+          $src_status_count{$src_status}++;
+
+        } else {
+          $src_status_count{$src_status} = 1;
+        }
+      }
+
+      # Destination status in column 1, source status in column 2
+      if ($self->verbose > 1) {
+        my @srcs = @{$self->files ($key)->src_actual};
+        print ($dest_status ? $dest_status : ' ');
+        print ($src_status ? $src_status : ' ');
+        print ' ' x 5, $key;
+        print ' (', join (', ', map {$_->id} @srcs), ')' if @srcs;
+        print "\n";
+      }
+    }
+
+    # Report number of files in each dest_status category
+    if (%dest_status_count) {
+      print 'Column 1: ' if $self->verbose > 1;
+      print 'Destination status summary:', "\n";
+      for my $key (sort keys %Fcm::ExtractFile::DEST_STATUS_CODE) {
+        next unless $key;
+        next if not exists ($dest_status_count{$key});
+        print '  No of files ';
+        print '[', $key, '] ' if $self->verbose > 1;
+        print $Fcm::ExtractFile::DEST_STATUS_CODE{$key}, ': ',
+              $dest_status_count{$key}, "\n";
+      }
+    }
+
+    # Report number of files in each dest_status category
+    if (%src_status_count) {
+      print 'Column 2: ' if $self->verbose > 1;
+      print 'Source status summary:', "\n";
+      for my $key (sort keys %Fcm::ExtractFile::SRC_STATUS_CODE) {
+        next unless $key;
+        next if not exists ($src_status_count{$key});
+        print '  No of files ';
+        print '[', $key, '] ' if $self->verbose > 1;
+        print $Fcm::ExtractFile::SRC_STATUS_CODE{$key}, ': ',
+              $src_status_count{$key}, "\n";
+      }
+    }
+  }
+
+  # Record configuration of current extract for each file
+  # ----------------------------------------------------------------------------
+  my @new_lines;
+  if (defined ($rc)) {
+    for my $key (sort keys %new) {
+      push @new_lines, Fcm::CfgLine->new (label => $key, value => $new{$key});
+    }
+  }
+
+  return ($rc, \@new_lines);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @array = $self->sort_bdeclare ();
+#
+# DESCRIPTION
+#   This method returns sorted build declarations, filtering out repeated
+#   entries, where possible.
+# ------------------------------------------------------------------------------
+
+sub sort_bdeclare {
+  my $self = shift;
+
+  # Get list of build configuration labels that can be declared multiple times
+  my %cfg_keyword = map {
+    ($self->cfglabel ($_), 1)
+  } split (/$Fcm::Config::DELIMITER_LIST/, $self->setting ('CFG_KEYWORD'));
+
+  my @bdeclares = ();
+  for my $d (reverse @{ $self->bdeclare }) {
+    # Reconstruct array from bottom up
+    # * always add declarations that can be declared multiple times
+    # * otherwise add only if it is declared below
+    unshift @bdeclares, $d
+      if exists $cfg_keyword{uc (($d->slabel_fields)[0])} or
+         not grep {$_->slabel eq $d->slabel} @bdeclares;
+  }
+
+  return (sort {$a->slabel cmp $b->slabel} @bdeclares);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   See description of Fcm::ConfigSystem->to_cfglines for further information.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+
+  return (
+    Fcm::ConfigSystem::to_cfglines($self),
+
+    $self->rdest->to_cfglines (),
+    Fcm::CfgLine->new (),
+
+    @{ $self->bdeclare } ? (
+      Fcm::CfgLine::comment_block ('Build declarations'),
+      map {
+        Fcm::CfgLine->new (label => $_->label, value => $_->value)
+      } ($self->sort_bdeclare),
+      Fcm::CfgLine->new (),
+    ) : (),
+
+    Fcm::CfgLine::comment_block ('Project and branches'),
+    (map {($_->to_cfglines ())} @{ $self->branches }),
+
+    ($self->conflict ne 'merge') ? (
+      Fcm::CfgLine->new (
+        label => $self->cfglabel ('CONFLICT'), value => $self->conflict,
+      ),
+      Fcm::CfgLine->new (),
+    ) : (),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines_bld ();
+#
+# DESCRIPTION
+#   Returns a list of configuration lines of the current extract suitable for
+#   feeding into the build system.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines_bld {
+  my ($self) = @_;
+
+  my $dest = $self->rdest->rootdir ? 'rdest' : 'dest';
+  my $root = File::Spec->catfile ('$HERE', '..');
+
+  my @inherits;
+  my @no_inherits;
+  if (@{ $self->inherit }) {
+    # List of inherited builds
+    for (@{ $self->inherit }) {
+      push @inherits, Fcm::CfgLine->new (
+        label => $self->cfglabel ('USE'), value => $_->$dest->rootdir
+      );
+    }
+
+    # List of files that should not be inherited
+    for my $key (sort keys %{ $self->files }) {
+      next unless $self->files ($key)->dest_status eq 'd';
+      my $label = join ('::', (
+        $self->cfglabel ('INHERIT'),
+        $self->cfglabel ('FILE'),
+        split (m#/#, $self->files ($key)->pkgname),
+      ));
+      push @no_inherits, Fcm::CfgLine->new (label => $label, value => 'false');
+    }
+  }
+
+  return (
+    Fcm::CfgLine::comment_block ('File header'),
+    (map
+      {my ($lbl, $val) = @{$_}; Fcm::CfgLine->new(label => $lbl, value => $val)}
+      (
+        [$self->cfglabel('CFGFILE') . $Fcm::Config::DELIMITER . 'TYPE'   , 'bld'],
+        [$self->cfglabel('CFGFILE') . $Fcm::Config::DELIMITER . 'VERSION', '1.0'],
+        [],
+      )
+    ),
+
+    @{ $self->inherit } ? (
+      @inherits,
+      @no_inherits,
+      Fcm::CfgLine->new (),
+    ) : (),
+
+    Fcm::CfgLine::comment_block ('Destination'),
+    Fcm::CfgLine->new (label => $self->cfglabel ('DEST'), value => $root),
+    Fcm::CfgLine->new (),
+
+    @{ $self->bdeclare } ? (
+      Fcm::CfgLine::comment_block ('Build declarations'),
+      map {
+        Fcm::CfgLine->new (label => $_->slabel, value => $_->value)
+      } ($self->sort_bdeclare),
+      Fcm::CfgLine->new (),
+    ) : (),
+  );
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->write_cfg ();
+#
+# DESCRIPTION
+#   This method writes the configuration file at the end of the run. It calls
+#   $self->write_cfg_system ($cfg) to write any system specific settings.
+# ------------------------------------------------------------------------------
+
+sub write_cfg {
+  my $self = shift;
+
+  my $cfg = Fcm::CfgFile->new (TYPE => $self->type);
+  $cfg->lines ([$self->to_cfglines()]);
+  $cfg->print_cfg ($self->dest->extcfg);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $self->write_cfg_bld ();
+#
+# DESCRIPTION
+#   This internal method writes the build configuration file.
+# ------------------------------------------------------------------------------
+
+sub write_cfg_bld {
+  my $self = shift;
+
+  my $cfg = Fcm::CfgFile->new (TYPE => 'bld');
+  $cfg->lines ([$self->to_cfglines_bld()]);
+  $cfg->print_cfg ($self->dest->bldcfg);
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/ExtractConfigComparator.pm
===================================================================
--- vendors/FCM/lib/Fcm/ExtractConfigComparator.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/ExtractConfigComparator.pm	(revision 9621)
@@ -0,0 +1,358 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+################################################################################
+# A generic reporter of the comparator's result
+{
+    package Reporter;
+
+    ############################################################################
+    # Class method: Constructor
+    sub new {
+        my ($class) = @_;
+        return bless(\do{my $annon_scalar}, $class);
+    }
+
+    ############################################################################
+    # Class method: Factory for Reporter object
+    sub get_reporter {
+        my ($self, $comparator) = @_;
+        my $class = defined($comparator->get_wiki()) ? 'WikiReporter'
+                  :                                    'TextReporter'
+                  ;
+        return $class->new();
+    }
+
+    ############################################################################
+    # Reports the results
+    sub report {
+        my ($self, $comparator) = @_;
+        if (keys(%{$comparator->get_log_of()})) {
+            print("Revisions at which extract declarations are modified:\n\n");
+        }
+        $self->report_impl($comparator);
+    }
+
+    ############################################################################
+    # Does the actual reporting
+    sub report_impl {
+        my ($self, $comparator) = @_;
+    }
+}
+
+################################################################################
+# Reports the comparator's result in Trac wiki format
+{
+    package WikiReporter;
+    our @ISA = qw{Reporter};
+
+    use Fcm::CmUrl;
+    use Fcm::Keyword;
+    use Fcm::Util qw{tidy_url};
+
+    ############################################################################
+    # Reports the comparator's result
+    sub report_impl {
+        my ($self, $comparator) = @_;
+        # Output in wiki format
+        my $wiki_url = Fcm::CmUrl->new(
+            URL => tidy_url(Fcm::Keyword::expand($comparator->get_wiki()))
+        );
+        my $base_trac
+            = $comparator->get_wiki()
+            ? Fcm::Keyword::get_browser_url($wiki_url->project_url())
+            : $wiki_url;
+        if (!$base_trac) {
+            $base_trac = $wiki_url;
+        }
+
+        for my $key (sort keys(%{$comparator->get_log_of()})) {
+            my $branch_trac = Fcm::Keyword::get_browser_url($key);
+            $branch_trac =~ s{\A $base_trac (?:/*|\z)}{source:}xms;
+            print("[$branch_trac]:\n");
+            my %branch_of = %{$comparator->get_log_of()->{$key}};
+            for my $rev (sort {$b <=> $a} keys(%branch_of)) {
+                print(
+                    $branch_of{$rev}->display_svnlog($rev, $base_trac), "\n",
+                );
+            }
+            print("\n");
+        }
+    }
+}
+
+################################################################################
+# Reports the comparator's result in simple text format
+{
+    package TextReporter;
+    our @ISA = qw{Reporter};
+
+    use Fcm::Config;
+
+    my $SEPARATOR = q{-} x 80 . "\n";
+
+    ############################################################################
+    # Reports the comparator's result
+    sub report_impl {
+        my ($self, $comparator) = @_;
+        for my $key (sort keys(%{$comparator->get_log_of()})) {
+            # Output in plain text format
+            print $key, ':', "\n";
+            my %branch_of = %{$comparator->get_log_of()->{$key}};
+            if (Fcm::Config->instance()->verbose() > 1) {
+                for my $rev (sort {$b <=> $a} keys(%branch_of)) {
+                    print(
+                        $SEPARATOR, $branch_of{$rev}->display_svnlog($rev), "\n"
+                    );
+                }
+            }
+            else {
+                print(join(q{ }, sort {$b <=> $a} keys(%branch_of)), "\n");
+            }
+            print $SEPARATOR, "\n";
+        }
+    }
+}
+
+package Fcm::ExtractConfigComparator;
+
+use Fcm::CmUrl;
+use Fcm::Extract;
+
+################################################################################
+# Class method: Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns an array containing the 2 configuration files to compare
+sub get_files {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{files}} : $self->{files});
+}
+
+################################################################################
+# Returns the wiki link on wiki mode
+sub get_wiki {
+    my ($self) = @_;
+    return $self->{wiki};
+}
+
+################################################################################
+# Returns the result log
+sub get_log_of {
+    my ($self) = @_;
+    return (wantarray() ? %{$self->{log_of}} : $self->{log_of});
+}
+
+################################################################################
+# Invokes the comparator
+sub invoke {
+    my ($self) = @_;
+
+    # Reads the extract configurations
+    my (@cfg, $rc);
+    for my $i (0 .. 1) {
+        $cfg[$i] = Fcm::Extract->new();
+        $cfg[$i]->cfg()->src($self->get_files()->[$i]);
+        $cfg[$i]->parse_cfg();
+        $rc = $cfg[$i]->expand_cfg();
+        if (!$rc) {
+            e_report();
+        }
+    }
+
+    # Get list of URLs
+    # --------------------------------------------------------------------------
+    my @urls = ();
+    for my $i (0 .. 1) {
+        # List of branches in each extract configuration file
+        my @branches = @{$cfg[$i]->branches()};
+        BRANCH:
+        for my $branch (@branches) {
+            # Ignore declarations of local directories
+            if ($branch->type() eq 'user') {
+                next BRANCH;
+            }
+
+            # List of SRC declarations in each branch
+            my %dirs = %{$branch->dirs()};
+
+            for my $dir (values(%dirs)) {
+                # Set up a new instance of Fcm::CmUrl object for each SRC
+                my $cm_url = Fcm::CmUrl->new (
+                    URL => $dir . (
+                        $branch->revision() ? '@' . $branch->revision() : q{}
+                    ),
+                );
+
+                $urls[$i]{$cm_url->branch_url()}{$dir} = $cm_url;
+            }
+        }
+    }
+
+    # Compare
+    # --------------------------------------------------------------------------
+    $self->{log_of} = {};
+    for my $i (0 .. 1) {
+        # Compare the first file with the second one and then vice versa
+        my $j = ($i == 0) ? 1 : 0;
+
+        for my $branch (sort keys(%{$urls[$i]})) {
+            if (exists($urls[$j]{$branch})) {
+                # Same REPOS declarations in both files
+                DIR:
+                for my $dir (sort keys(%{$urls[$i]{$branch}})) {
+                    if (exists($urls[$j]{$branch}{$dir})) {
+                        if ($i == 1) {
+                            next DIR;
+                        }
+
+                        my $this_url = $urls[$i]{$branch}{$dir};
+                        my $that_url = $urls[$j]{$branch}{$dir};
+
+                        # Compare their last changed revisions
+                        my $this_rev
+                            = $this_url->svninfo(FLAG => 'Last Changed Rev');
+                        my $that_rev
+                            = $that_url->svninfo(FLAG => 'Last Changed Rev');
+
+                        # Make sure last changed revisions differ
+                        if ($this_rev eq $that_rev) {
+                            next DIR;
+                        }
+
+                        # Not interested in the log before the minimum revision
+                        my $min_rev
+                            = $this_url->pegrev() > $that_url->pegrev()
+                              ? $that_url->pegrev() : $this_url->pegrev();
+
+                        $this_rev = $min_rev if $this_rev < $min_rev;
+                        $that_rev = $min_rev if $that_rev < $min_rev;
+
+                        # Get list of changed revisions using the commit log
+                        my $u = ($this_rev > $that_rev) ? $this_url : $that_url;
+                        my %revs = $u->svnlog(REV => [$this_rev, $that_rev]);
+
+                        REV:
+                        for my $rev (keys %revs) {
+                            # Check if revision is already in the list
+                            if (
+                                   exists($self->{log_of}{$branch}{$rev})
+                                || $rev == $min_rev
+                            ) {
+                                next REV;
+                            }
+
+                            # Get list of changed paths. Accept this revision
+                            # only if it contains changes in the current branch
+                            my %paths  = %{$revs{$rev}{paths}};
+
+                            PATH:
+                            for my $path (keys(%paths)) {
+                                my $change_url
+                                    = Fcm::CmUrl->new(URL => $u->root() . $path);
+
+                                if ($change_url->branch() eq $u->branch()) {
+                                    $self->{log_of}{$branch}{$rev} = $u;
+                                    last PATH;
+                                }
+                            }
+                        }
+                    }
+                    else {
+                        $self->_report_added(
+                            $urls[$i]{$branch}{$dir}->url_peg(), $i, $j);
+                    }
+                }
+            }
+            else {
+                $self->_report_added($branch, $i, $j);
+            }
+        }
+    }
+
+    my $reporter = Reporter->get_reporter($self);
+    $reporter->report($self);
+    return $rc;
+}
+
+################################################################################
+# Reports added/deleted declaration
+sub _report_added {
+    my ($self, $branch, $i, $j) = @_;
+    printf(
+        "%s:\n  in    : %s\n  not in: %s\n\n",
+        $branch, $self->get_files()->[$i], $self->get_files()->[$j],
+    );
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::ExtractConfigComparator
+
+=head1 SYNOPSIS
+
+    use Fcm::ExtractConfigComparator;
+    my $comparator = Fcm::ExtractConfigComparator->new({files => \@files});
+    $comparator->invoke();
+
+=head1 DESCRIPTION
+
+An object of this class represents a comparator of FCM extract configuration.
+It is used to compare the VC branch declarations in 2 FCM extract configuration
+files.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({files =E<gt> \@files, wiki =E<gt> $wiki})>
+
+Constructor.
+
+=item get_files()
+
+Returns an array containing the 2 configuration files to compare.
+
+=item get_wiki()
+
+Returns the wiki link on wiki mode.
+
+=item invoke()
+
+Invokes the comparator.
+
+=back
+
+=head1 TO DO
+
+More documentation.
+
+Improve the parser for extract configuration.
+
+Separate the comparator with the reporters.
+
+Add reporter to display HTML.
+
+More unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::Extract|Fcm::Extract>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/ExtractFile.pm
===================================================================
--- vendors/FCM/lib/Fcm/ExtractFile.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/ExtractFile.pm	(revision 9621)
@@ -0,0 +1,410 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ExtractFile
+#
+# DESCRIPTION
+#   Select/combine a file in different branches and extract it to destination.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package Fcm::ExtractFile;
+use base qw{Fcm::Base};
+
+use Fcm::Util      qw{run_command w_report};
+use File::Basename qw{dirname};
+use File::Compare  qw{compare};
+use File::Copy     qw{copy};
+use File::Path     qw{mkpath};
+use File::Spec;
+use File::Temp     qw(tempfile);
+
+# List of property methods for this class
+my @scalar_properties = (
+  'conflict',    # conflict mode
+  'dest',        # search path to destination file
+  'dest_status', # destination status, see below
+  'pkgname',     # package name of this file
+  'src',         # list of Fcm::ExtractSrc, specified for this file
+  'src_actual',  # list of Fcm::ExtractSrc, actually used by this file
+  'src_status',  # source status, see below
+);
+
+# Status code definition for $self->dest_status
+our %DEST_STATUS_CODE = (
+  ''  => 'unchanged',
+  'M' => 'modified',
+  'A' => 'added',
+  'a' => 'added, overridding inherited',
+  'D' => 'deleted',
+  'd' => 'deleted, overridding inherited',
+  '?' => 'irrelevant',
+);
+
+# Status code definition for $self->src_status
+our %SRC_STATUS_CODE = (
+  'A' => 'added by a branch',
+  'B' => 'from the base',
+  'D' => 'deleted by a branch',
+  'M' => 'modified by a branch',
+  'G' => 'merged from 2+ branches',
+  'O' => 'overridden by a branch',
+  '?' => 'irrelevant',
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ExtractFile->new ();
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ExtractFile class.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{$_} ? $args{$_} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'conflict') {
+        $self->{$name} = 'merge'; # default to "merge" mode
+
+      } elsif ($name eq 'dest' or $name eq 'src' or $name eq 'src_actual') {
+        $self->{$name} = [];      # default to an empty list
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run();
+#
+# DESCRIPTION
+#   This method runs only if $self->dest_status is not defined. It updates the
+#   destination according to the source in the list and the conflict mode
+#   setting. It updates the file in $self->dest as appropriate and sets
+#   $self->dest_status. (See above.) This method returns true on success.
+# ------------------------------------------------------------------------------
+
+sub run {
+  my ($self) = @_;
+  my $rc = 1;
+
+  if (not defined ($self->dest_status)) {
+    # Assume file unchanged
+    $self->dest_status ('');
+
+    if (@{ $self->src }) {
+      my $used;
+      # Determine or set up a file for comparing with the destination
+      ($rc, $used) = $self->run_get_used();
+
+      # Attempt to compare the destination with $used. Update on change.
+      if ($rc) {
+        $rc = defined ($used) ? $self->run_update($used) : $self->run_delete();
+      }
+
+    } else {
+      # No source, delete file in destination
+      $self->src_status ('?');
+      $rc = $self->run_delete();
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run_delete();
+#
+# DESCRIPTION
+#   This method is part of run(). It detects this file in the destination path.
+#   If this file is in the current destination, it attempts to delete it and
+#   sets the dest_status to "D". If this file is in an inherited destination,
+#   it sets the dest_status to "d".
+# ------------------------------------------------------------------------------
+
+sub run_delete {
+  my ($self) = @_;
+
+  my $rc = 1;
+
+  $self->dest_status ('?');
+  for my $i (0 .. @{ $self->dest } - 1) {
+    my $dest = File::Spec->catfile ($self->dest->[$i], $self->pkgname);
+    next unless -f $dest;
+    if ($i == 0) {
+      $rc = unlink $dest;
+      $self->dest_status ('D');
+
+    } else {
+      $self->dest_status ('d');
+      last;
+    }
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $used) = $obj->run_get_used();
+#
+# DESCRIPTION
+#   This method is part of run(). It attempts to work out or set up the $used
+#   file. ($used is undef if it is not defined in a branch for this file.)
+# ------------------------------------------------------------------------------
+
+sub run_get_used {
+  my ($self) = @_;
+  my $rc = 1;
+  my $used;
+
+  my @sources = ($self->src->[0]);
+  my $src_status = 'B';
+  if (defined ($self->src->[0]->cache)) {
+    # File exists in base branch
+    for my $i (1 .. @{ $self->src } - 1) {
+      if (defined ($self->src->[$i]->cache)) {
+        # Detect changes in this file between base branch and branch $i
+        push @sources, $self->src->[$i]
+          if &compare ($self->src->[0]->cache, $self->src->[$i]->cache);
+
+      } else {
+        # File deleted in branch $i
+        @sources = ($self->src->[$i]);
+        last unless $self->conflict eq 'override';
+      }
+    }
+
+    if ($rc) {
+      if (@sources > 2) {
+        if ($self->conflict eq 'fail') {
+          # On conflict, fail in fail mode
+          w_report 'ERROR: ', $self->pkgname,
+                   ': modified in 2+ branches in fail conflict mode.';
+          $rc = undef;
+
+        } elsif ($self->conflict eq 'override') {
+          $used = $sources[-1]->cache;
+          $src_status = 'O';
+
+        } else {
+          # On conflict, attempt to merge in merge mode
+          ($rc, $used) = $self->run_get_used_by_merge (@sources);
+          $src_status = 'G' if $rc;
+        }
+
+      } else {
+        # 0 or 1 change, use last source
+        if (defined $sources[-1]->cache) {
+          $used = $sources[-1]->cache;
+          $src_status = 'M' if @sources > 1;
+
+        } else {
+          $src_status = 'D';
+        }
+      }
+    }
+
+  } else {
+    # File does not exist in base branch
+    @sources = ($self->src->[-1]);
+    $used = $self->src->[1]->cache;
+    $src_status = (defined ($used) ? 'A' : 'D');
+    if ($self->conflict ne 'override' and defined ($used)) {
+      for my $i (1 - @{ $self->src } .. -2) {
+        # Allow this only if files are the same in all branches
+        my $file = $self->src->[$i]->cache;
+        if ((not defined ($file)) or &compare ($used, $file)) {
+          w_report 'ERROR: ', $self->pkgname, ': cannot merge:',
+                   ' not found in base branch,',
+                   ' but differs in subsequent branches.';
+          $rc = undef;
+          last;
+
+        } else {
+          unshift @sources, $self->src->[$i];
+        }
+      }
+    }
+  }
+
+  $self->src_status ($src_status);
+  $self->src_actual (\@sources);
+
+  return ($rc, $used);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   ($rc, $used) = $obj->run_get_used_by_merge(@soruces);
+#
+# DESCRIPTION
+#   This method is part of run_get_used(). It attempts to merge the files in
+#   @sources and return a temporary file $used. @sources should be an array of
+#   Fcm::ExtractSrc objects. On success, $rc will be set to true.
+# ------------------------------------------------------------------------------
+
+sub run_get_used_by_merge {
+  my ($self, @sources) = @_;
+  my $rc = 1;
+
+  # Get temporary file
+  my ($fh, $used) = &tempfile ('fcm.ext.merge.XXXXXX', UNLINK => 1);
+  close $fh or die $used, ': cannot close';
+
+  for my $i (2 .. @sources - 1) {
+    # Invoke the diff3 command to merge
+    my $mine = ($i == 2 ? $sources[1]->cache : $used);
+    my $older = $sources[0]->cache;
+    my $yours = $sources[$i]->cache;
+    my @command = (
+      $self->setting (qw/TOOL DIFF3/),
+      split (/\s+/, $self->setting (qw/TOOL DIFF3FLAGS/)),
+      $mine, $older, $yours,
+    );
+    my $code;
+    my @out = &run_command (
+      \@command,
+      METHOD => 'qx',
+      ERROR  => 'ignore',
+      PRINT  => $self->verbose > 1,
+      RC     => \$code,
+      TIME   => $self->verbose > 2,
+    );
+
+    if ($code) {
+      # Failure, report and return
+      my $m = ($code == 1)
+              ? 'cannot resolve conflicts:'
+              : $self->setting (qw/TOOL DIFF3/) . 'command failed';
+      w_report 'ERROR: ', $self->pkgname, ': merge - ', $m;
+      if ($code == 1 and $self->verbose) {
+        for (0 .. $i) {
+          my $src = $sources[$_]->uri eq $sources[$_]->cache
+                    ? $sources[$_]->cache
+                    : ($sources[$_]->uri . '@' . $sources[$_]->rev);
+          w_report '  source[', $_, ']=', $src;
+        }
+
+        for (0 .. $i) {
+          w_report '  cache', $_, '=', $sources[$_]->cache;
+        }
+
+        w_report @out if $self->verbose > 2;
+      }
+      $rc = undef;
+      last;
+
+    } else {
+      # Success, write result to temporary file
+      open FILE, '>', $used or die $used, ': cannot open (', $!, ')';
+      print FILE @out;
+      close FILE or die $used, ': cannot close (', $!, ')';
+
+      # File permission, use most permissive combination of $mine and $yours
+      my $perm = ((stat($mine))[2] & 07777) | ((stat($yours))[2] & 07777);
+      chmod ($perm, $used);
+    }
+  }
+
+  return ($rc, $used);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->run_update($used_file);
+#
+# DESCRIPTION
+#   This method is part of run(). It compares the $used_file with the one in
+#   the destination. If the file does not exist in the destination or if its
+#   content is out of date, the destination is updated with the content in the
+#   $used_file. Returns true on success.
+# ------------------------------------------------------------------------------
+
+sub run_update {
+  my ($self, $used_file) = @_;
+  my ($is_diff, $is_diff_in_perms, $is_in_prev, $rc) = (1, 1, undef, 1);
+
+  # Compare with the previous version if it exists
+  DEST:
+  for my $i (0 .. @{$self->dest()} - 1) {
+    my $prev_file = File::Spec->catfile($self->dest()->[$i], $self->pkgname());
+    if (-f $prev_file) {
+      $is_in_prev = $i;
+      $is_diff = compare($used_file, $prev_file);
+      $is_diff_in_perms = (stat($used_file))[2] != (stat($prev_file))[2];
+      last DEST;
+    }
+  }
+  if (!$is_diff && !$is_diff_in_perms) {
+    return $rc;
+  }
+
+  # Update destination
+  my $dest_file = File::Spec->catfile($self->dest()->[0], $self->pkgname());
+  if ($is_diff) {
+    my $dir = dirname($dest_file);
+    if (!-d $dir) {
+      mkpath($dir);
+    }
+    $rc = copy($used_file, $dest_file);
+  }
+  $rc &&= chmod((stat($used_file))[2] & oct(7777), $dest_file);
+  if ($rc) {
+    $self->dest_status(
+        $is_in_prev          ? 'a'
+      : defined($is_in_prev) ? 'M'
+      :                        'A'
+    );
+  }
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/ExtractSrc.pm
===================================================================
--- vendors/FCM/lib/Fcm/ExtractSrc.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/ExtractSrc.pm	(revision 9621)
@@ -0,0 +1,87 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ExtractSrc
+#
+# DESCRIPTION
+#   This class is used by the extract system to define the functionalities of a
+#   source file (or directory) in a branch.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::ExtractSrc;
+@ISA = qw(Fcm::Base);
+
+# Standard pragma
+use warnings;
+use strict;
+
+# FCM component modules
+use Fcm::Base;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'cache',   # location of the cache of this file in the current extract
+  'id',      # short ID of the branch where this file is from
+  'ignore',  # if set to true, ignore this file from this source
+  'pkgname', # package name of this file
+  'rev',     # last changed revision/timestamp of this file
+  'uri',     # URL/source path of this file
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ExtractSrc->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ExtractSrc class. See
+#   @scalar_properties above for allowed list of properties in the constructor.
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{$_} ? $args{$_} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Interactive.pm
===================================================================
--- vendors/FCM/lib/Fcm/Interactive.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Interactive.pm	(revision 9621)
@@ -0,0 +1,131 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw{get_input};
+
+use Fcm::Util::ClassLoader;
+
+my $DEFAULT_IMPL_CLASS = 'Fcm::Interactive::InputGetter::CLI';
+my %DEFAULT_IMPL_CLASS_OPTIONS = ();
+
+my $IMPL_CLASS = $DEFAULT_IMPL_CLASS;
+my %IMPL_CLASS_OPTIONS = %DEFAULT_IMPL_CLASS_OPTIONS;
+
+################################################################################
+# Returns the name of the current class/settings for getting input
+sub get_impl {
+    return (wantarray() ? ($IMPL_CLASS, \%IMPL_CLASS_OPTIONS) : $IMPL_CLASS);
+}
+
+################################################################################
+# Returns the name of the current class/settings for getting input
+sub get_default_impl {
+    return (
+        wantarray()
+        ? ($DEFAULT_IMPL_CLASS, \%DEFAULT_IMPL_CLASS_OPTIONS)
+        : $DEFAULT_IMPL_CLASS
+    );
+}
+
+################################################################################
+# Sets the name of the class/settings for getting input
+sub set_impl {
+    my ($impl_class, $impl_class_options_ref) = @_;
+    if ($impl_class) {
+        $IMPL_CLASS = $impl_class;
+        if ($impl_class_options_ref) {
+            %IMPL_CLASS_OPTIONS = (%{$impl_class_options_ref});
+        }
+        else {
+            %IMPL_CLASS_OPTIONS = ();
+        }
+    }
+}
+
+################################################################################
+# Gets an input from the user and returns it
+sub get_input {
+    my (%options) = @_;
+    my ($class_name, $class_options_ref) = get_impl();
+    Fcm::Util::ClassLoader::load($class_name);
+    %options = map {lc($_), $options{$_}} keys(%options);
+    return $class_name->new({%{$class_options_ref}, %options})->invoke();
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive;
+    Fcm::Interactive::set_impl('My::InputGetter', {option1 => 'value1', ...});
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+Common interface for getting an interactive user reply. The default is to use a
+L<Fcm::Interactive::InputGetter::CLI|Fcm::Interactive::InputGetter::CLI> object
+with no extra options.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item get_impl()
+
+Returns the class that implements the function for get_input(%options). In
+scalar context, returns the class name only. In list context, returns the class
+name and the extra hash options that would be passed to its constructor.
+
+=item get_default_impl()
+
+Returns the defaut values for get_impl().
+
+=item set_impl($impl_class,$impl_class_options_ref)
+
+Sets the class that implements the function for get_input(%options). The name
+of the class is given in $impl_class. Any extra options that should be given to
+the constructor should be set in the hash reference $impl_class_options_ref.
+
+=item get_input(%options)
+
+Calls the appropriate function to get an input string from the user, and
+returns it.
+
+Input options are: I<title>, for a short title of the prompt, I<message>, for
+the message prompt, I<type> for the prompt type, and I<default> for the default
+value of the return value.
+
+Prompt type can be YN (yes or no), YNA (yes, no or all) or input (for an input
+string).
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>,
+L<Fcm::Interactive::InputGetter::CLI|Fcm::Interactive::InputGetter::CLI>,
+L<Fcm::Interactive::InputGetter::GUI|Fcm::Interactive::InputGetter::GUI>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Interactive/InputGetter.pm
===================================================================
--- vendors/FCM/lib/Fcm/Interactive/InputGetter.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Interactive/InputGetter.pm	(revision 9621)
@@ -0,0 +1,122 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive::InputGetter;
+
+use Carp qw{croak};
+
+################################################################################
+# Constructor
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    ############################################################################
+    # Returns the title of the prompt
+    'title',
+    ############################################################################
+    # Returns the message of the prompt
+    'message',
+    ############################################################################
+    # Returns the of the prompt
+    'type',
+    ############################################################################
+    # Returns the default return value
+    'default',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Invokes the getter
+sub invoke {
+    my ($self) = @_;
+    croak("Fcm::Interactive::InputGetter->invoke() not implemented.");
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive::TxtInputGetter
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive::TxtInputGetter;
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+An object of this abstract class is used by
+L<Fcm::Interactive|Fcm::Interactive> to get a user reply.
+
+=head1 METHODS
+
+=over 4
+
+=item new($args_ref)
+
+Constructor, normally invoked via L<Fcm::Interactive|Fcm::Interactive>.
+
+Input options are: I<title>, for a short title of the prompt, I<message>, for
+the message prompt, I<type> for the prompt type, and I<default> for the default
+value of the return value.
+
+Prompt type can be YN (yes or no), YNA (yes, no or all) or input (for an input
+string).
+
+=item get_title()
+
+Returns the title of the prompt.
+
+=item get_message()
+
+Returns the message of the prompt.
+
+=item get_type()
+
+Returns the type of the prompt, can be YN (yes or no), YNA (yes, no or all) or
+input (for an input string).
+
+=item get_default()
+
+Returns the default return value of invoke().
+
+=item invoke()
+
+Gets an input string from the user, and returns it. Sub-classes must override
+this method.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive|Fcm::Interactive>,
+L<Fcm::Interactive::TxtInputGetter|Fcm::Interactive::TxtInputGetter>,
+L<Fcm::Interactive::GUIInputGetter|Fcm::Interactive::GUIInputGetter>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- vendors/FCM/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Interactive/InputGetter/CLI.pm	(revision 9621)
@@ -0,0 +1,87 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive::InputGetter::CLI;
+use base qw{Fcm::Interactive::InputGetter};
+
+my $DEF_MSG = q{ (or just press <return> for "%s")};
+my %EXTRA_MSG_FOR = (
+    yn  => qq{\nEnter "y" or "n"},
+    yna => qq{\nEnter "y", "n" or "a"},
+);
+my %CHECKER_FOR = (
+    yn  => sub {$_[0] eq 'y' || $_[0] eq 'n'},
+    yna => sub {$_[0] eq 'y' || $_[0] eq 'n' || $_[0] eq 'a'},
+);
+
+sub invoke {
+    my ($self) = @_;
+    my $type = $self->get_type() ? lc($self->get_type()) : q{};
+    my $message
+        = $self->get_message()
+        . (exists($EXTRA_MSG_FOR{$type}) ? $EXTRA_MSG_FOR{$type} : q{})
+        . ($self->get_default() ? sprintf($DEF_MSG, $self->get_default()) : q{})
+        . q{: }
+        ;
+    while (1) {
+        print($message);
+        my $answer = readline(STDIN);
+        chomp($answer);
+        if (!$answer && $self->get_default()) {
+            $answer = $self->get_default();
+        }
+        if (!exists($CHECKER_FOR{$type}) || $CHECKER_FOR{$type}->($answer)) {
+            return $answer;
+        }
+    }
+    return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive::InputGetter::CLI
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive;
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+This is a solid implementation of
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>. It gets a user
+reply from STDIN using a prompt on STDOUT.
+
+=head1 METHODS
+
+See L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter> for a list of
+methods.
+
+=head1 TO DO
+
+Use IO::Prompt.
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive|Fcm::Interactive>,
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>,
+L<Fcm::Interactive::InputGetter::GUI|Fcm::Interactive::InputGetter::GUI>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Interactive/InputGetter/GUI.pm
===================================================================
--- vendors/FCM/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Interactive/InputGetter/GUI.pm	(revision 9621)
@@ -0,0 +1,248 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Interactive::InputGetter::GUI;
+use base qw{Fcm::Interactive::InputGetter};
+
+use Tk;
+
+################################################################################
+# Returns the geometry string for the pop up message box
+sub get_geometry {
+    my ($self) = @_;
+    return $self->{geometry};
+}
+
+################################################################################
+# Invokes the getter
+sub invoke {
+    my ($self) = @_;
+    my $answer;
+    local $| = 1;
+
+    # Create a main window
+    my $mw = MainWindow->new();
+    $mw->title($self->get_title());
+
+    # Define the default which applies if the dialog box is just closed or
+    # the user selects 'cancel'
+    $answer = $self->get_default() ? $self->get_default() : q{};
+
+    if (defined($self->get_type()) && $self->get_type() =~ qr{\A yn}ixms) {
+        # Create a yes-no(-all) dialog box
+
+        # If TYPE is YNA then add a third button: 'all'
+        my $buttons = $self->get_type() =~ qr{a \z}ixms ? 3 : 2;
+
+        # Message of the dialog box
+        $mw->Label('-text' => $self->get_message())->grid(
+            '-row'        => 0,
+            '-column'     => 0,
+            '-columnspan' => $buttons,
+            '-padx'       => 10,
+            '-pady'       => 10,
+        );
+
+        # The "yes" button
+        my $y_b = $mw->Button(
+            '-text'      => 'Yes',
+            '-underline' => 0,
+            '-command'   => sub {$answer = 'y'; $mw->destroy()},
+        )
+        ->grid('-row' => 1, '-column' => 0, '-padx' => 5, '-pady' => 5);
+
+        # The "no" button
+        my $n_b = $mw->Button (
+            '-text'      => 'No',
+            '-underline' => 0,
+            '-command'   => sub {$answer = 'n'; $mw->destroy()},
+        )
+        ->grid('-row' => 1, '-column' => 1, '-padx' => 5, '-pady' => 5);
+
+        # The "all" button
+        my $a_b;
+        if ($buttons == 3) {
+            $a_b = $mw->Button(
+                '-text'      => 'All',
+                '-underline' => 0,
+                '-command'   => sub {$answer = 'a'; $mw->destroy()},
+            )
+            ->grid('-row' => 1, '-column' => 2, '-padx' => 5, '-pady' => 5);
+        }
+
+        # Keyboard binding
+        if ($buttons == 3) {
+            $mw->bind('<Key>' => sub {
+                my $button
+                    = $Tk::event->K() eq 'Y' || $Tk::event->K() eq 'y' ? $y_b
+                    : $Tk::event->K() eq 'N' || $Tk::event->K() eq 'n' ? $n_b
+                    : $Tk::event->K() eq 'A' || $Tk::event->K() eq 'a' ? $a_b
+                    :                                                    undef
+                    ;
+                if (defined($button)) {
+                    $button->invoke();
+                }
+            });
+        }
+        else {
+            $mw->bind('<Key>' => sub {
+                my $button
+                    = $Tk::event->K() eq 'Y' || $Tk::event->K() eq 'y' ? $y_b
+                    : $Tk::event->K() eq 'N' || $Tk::event->K() eq 'n' ? $n_b
+                    :                                                    undef
+                    ;
+                if (defined($button)) {
+                    $button->invoke();
+                }
+            });
+        }
+
+        # Handle the situation when the user attempts to quit the window
+        $mw->protocol('WM_DELETE_WINDOW', sub {
+            if (self->get_default()) {
+                $answer = $self->get_default();
+            }
+            $mw->destroy();
+        });
+    }
+    else {
+        # Create a dialog box to obtain an input string
+        # Message of the dialog box
+        $mw->Label('-text' => $self->get_message())->grid(
+            '-row'    => 0,
+            '-column' => 0,
+            '-padx'   => 5,
+            '-pady'   => 5,
+        );
+
+        # Entry box for the user to type in the input string
+        my $entry   = $answer;
+        my $input_e = $mw->Entry(
+            '-textvariable' => \$entry,
+            '-width'        => 40,
+        )
+        ->grid(
+            '-row'    => 0,
+            '-column' => 1,
+            '-sticky' => 'ew',
+            '-padx'   => 5,
+            '-pady'   => 5,
+        );
+
+        my $b_f = $mw->Frame->grid(
+            '-row'        => 1,
+            '-column'     => 0,
+            '-columnspan' => 2,
+            '-sticky'     => 'e',
+        );
+
+        # An OK button to accept the input string
+        my $ok_b = $b_f->Button (
+            '-text' => 'OK',
+            '-command' => sub {$answer = $entry; $mw->destroy()},
+        )
+        ->grid('-row' => 0, '-column' => 0, '-padx' => 5, '-pady' => 5);
+
+        # A Cancel button to reject the input string
+        my $cancel_b = $b_f->Button(
+            '-text' => 'Cancel',
+            '-command' => sub {$answer = undef; $mw->destroy()},
+        )
+        ->grid('-row' => 0, '-column' => 1, '-padx' => 5, '-pady' => 5);
+
+        # Keyboard binding
+        $mw->bind ('<Key>' => sub {
+            if ($Tk::event->K eq 'Return' or $Tk::event->K eq 'KP_Enter') {
+                $ok_b->invoke();
+            }
+            elsif ($Tk::event->K eq 'Escape') {
+                $cancel_b->invoke();
+            }
+        });
+
+        # Allow the entry box to expand
+        $mw->gridColumnconfigure(1, '-weight' => 1);
+
+        # Set initial focus on the entry box
+        $input_e->focus();
+        $input_e->icursor('end');
+    }
+
+    $mw->geometry($self->get_geometry());
+
+    # Switch on "always on top" property for $mw
+    $mw->property(
+        qw/set _NET_WM_STATE ATOM/,
+        32,
+        ['_NET_WM_STATE_STAYS_ON_TOP'],
+        ($mw->toplevel()->wrapper())[0],
+    );
+
+    MainLoop();
+    return $answer;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Interactive::InputGetter::GUI
+
+=head1 SYNOPSIS
+
+    use Fcm::Interactive;
+    $answer = Fcm::Interactive::get_input(
+        title   => 'My title',
+        message => 'Would you like to ...?',
+        type    => 'yn',
+        default => 'n',
+    );
+
+=head1 DESCRIPTION
+
+This is a solid implementation of
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>. It gets a user
+reply from a TK pop up message box.
+
+=head1 METHODS
+
+See L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter> for a list of
+inherited methods.
+
+=over 4
+
+=item new($args_ref)
+
+As in L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>, but also
+accept a I<geometry> element for setting the geometry string of the pop up
+message box.
+
+=item get_geometry()
+
+Returns the geometry string for the pop up message box.
+
+=back
+
+=head1 TO DO
+
+Tidy up the logic of invoke(). Separate the logic for YN/A box and string input
+box, probably using a strategy pattern. Factor out the logic for the display
+and the return value.
+
+=head1 SEE ALSO
+
+L<Fcm::Interactive|Fcm::Interactive>,
+L<Fcm::Interactive::InputGetter|Fcm::Interactive::InputGetter>,
+L<Fcm::Interactive::InputGetter::CLI|Fcm::Interactive::InputGetter::CLI>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword.pm	(revision 9621)
@@ -0,0 +1,376 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword;
+
+use Carp qw{croak};
+use Fcm::Config;
+use Fcm::Exception;
+use Fcm::Keyword::Config;
+use Fcm::Keyword::Exception;
+use URI;
+
+my $ENTRIES;
+
+my $PREFIX_OF_LOCATION_KEYWORD = 'fcm';
+my $PATTERN_OF_RESERVED_REVISION_KEYWORDS
+    = qr{\A (?:\d+|HEAD|BASE|COMMITTED|PREV|\{[^\}]+\}) \z}ixms;
+
+################################################################################
+# Returns the Fcm::Keyword::Entries object for storing the location entries
+sub get_entries {
+    my ($reset) = @_;
+    if ($reset || !$ENTRIES) {
+        $ENTRIES = Fcm::Keyword::Config::get_entries('LOCATION_ENTRIES');
+    }
+    return $ENTRIES;
+}
+
+################################################################################
+# Returns a list of Fcm::Keyword::Entry::Location objects matching $in_loc
+sub get_location_entries_for {
+    my ($in_loc) = @_;
+    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc);
+    return (map {$_->[0]} @entry_trail_refs);
+}
+
+################################################################################
+# Returns the prefix of location keyword (with or without the delimiter).
+sub get_prefix_of_location_keyword {
+    my ($with_delimiter) = @_;
+    return $PREFIX_OF_LOCATION_KEYWORD . ($with_delimiter ? ':' : '');
+}
+
+################################################################################
+# Expands (the keywords in) the specfied location (and REV), and returns them
+sub expand {
+    my ($in_loc, $in_rev) = @_;
+    my ($loc, $rev) = _expand($in_loc, $in_rev);
+    return _unparse_loc($loc, $rev, $in_rev);
+}
+
+################################################################################
+# Returns the corresponding browser URL for the input VC location
+sub get_browser_url {
+    my ($in_loc, $in_rev) = @_;
+
+    my ($loc, $rev, @entry_trail_refs) = _expand($in_loc, $in_rev);
+    if (!@entry_trail_refs) {
+        croak(Fcm::Keyword::Exception->new({message => sprintf(
+            "%s: cannot be mapped to a browser URL", $in_loc,
+        )}));
+    }
+
+    my @entries = map {$_->[0]} @entry_trail_refs;
+    my $location_component_pattern
+        = _get_browser_url_setting(\@entries, 'location_component_pattern');
+    my $browser_url_template
+        = _get_browser_url_setting(\@entries, 'browser_url_template');
+    my $browser_rev_template
+        = _get_browser_url_setting(\@entries, 'browser_rev_template');
+
+    if (
+           $location_component_pattern
+        && $browser_url_template
+        && $browser_rev_template
+    ) {
+        my $uri = URI->new($loc);
+        my $sps = $uri->opaque();
+        my @matches = $sps =~ $location_component_pattern;
+        if (@matches) {
+            my $result = $browser_url_template;
+            for my $field_number (1 .. @matches) {
+                my $match = $matches[$field_number - 1];
+                $result =~ s/\{ $field_number \}/$match/xms;
+            }
+            my $rev_field = scalar(@matches) + 1;
+            if ($rev) {
+                my $rev_string = $browser_rev_template;
+                $rev_string =~ s/\{1\}/$rev/xms;
+                $result =~ s/\{ $rev_field \}/$rev_string/xms;
+            }
+            else {
+                $result =~ s/\{ $rev_field \}//xms;
+            }
+            return $result;
+        }
+    }
+    else {
+        croak(Fcm::Keyword::Exception->new({message => sprintf(
+            "%s: mapping templates not defined correctly", $in_loc,
+        )}));
+    }
+}
+
+################################################################################
+# Returns a browser URL setting, helper function for get_browser_url()
+sub _get_browser_url_setting {
+    my ($entries_ref, $setting) = @_;
+    my $getter = "get_$setting";
+    for my $entry (@{$entries_ref}) {
+        my $setting = $entry->$getter();
+        if ($setting) {
+            return $setting;
+        }
+    }
+    my $config = Fcm::Config->instance();
+    return $config->setting('URL_BROWSER_MAPPING_DEFAULT', uc($setting));
+}
+
+################################################################################
+# Un-expands the specfied location (and REV) to keywords, and returns them
+sub unexpand {
+    my ($in_loc, $in_rev) = @_;
+    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc, $in_rev);
+    if (@entry_trail_refs) {
+        my ($entry, $trail) = @{$entry_trail_refs[0]};
+        if ($rev) {
+            GET_REV_KEY:
+            for my $entry_trail_ref (@entry_trail_refs) {
+                my ($e, $t) = @{$entry_trail_ref};
+                my $rev_key
+                    = $e->get_revision_entries()->get_entry_by_value($rev);
+                if ($rev_key) {
+                    $rev = $rev_key->get_key();
+                    last GET_REV_KEY;
+                }
+            }
+        }
+        $loc = get_prefix_of_location_keyword(1) . $entry->get_key() . $trail;
+        return _unparse_loc($loc, $rev, $in_rev);
+    }
+    return _unparse_loc($in_loc, $in_rev, $in_rev);
+}
+
+################################################################################
+# Expands (the keywords in) the specfied location (and REV), and returns them
+sub _expand {
+    my ($in_loc, $in_rev) = @_;
+    my ($loc, $rev, @entry_trail_refs) = _parse_loc($in_loc, $in_rev);
+    if (@entry_trail_refs) {
+        my ($entry, $trail) = @{$entry_trail_refs[0]};
+        $loc = $entry->get_value() . $trail;
+        if ($rev && $rev !~ $PATTERN_OF_RESERVED_REVISION_KEYWORDS) {
+            my $r;
+            GET_REV:
+            for my $entry_trail_ref (@entry_trail_refs) {
+                my ($e, $t) = @{$entry_trail_ref};
+                $r = $e->get_revision_entries()->get_entry_by_key($rev);
+                if ($r) {
+                    $rev = $r->get_value();
+                    last GET_REV;
+                }
+            }
+            if (!$r) {
+                croak(Fcm::Keyword::Exception->new({message => sprintf(
+                    "%s: %s: unknown revision keyword",
+                    $loc, $rev,
+                )}));
+            }
+        }
+    }
+    return ($loc, $rev, @entry_trail_refs);
+}
+
+################################################################################
+# Parses $in_loc (and $in_rev)
+sub _parse_loc {
+    my ($in_loc, $in_rev) = @_;
+    if (!$in_loc) {
+        croak(Fcm::Exception->new({
+            message => 'internal error: $in_loc not defined',
+        }));
+    }
+    if ($in_loc) {
+        if (!defined($in_rev)) {
+            my ($loc, $rev) = $in_loc =~ qr{\A (.+) \@ ([^/\@]+) \z}xms;
+            if ($loc && $rev) {
+                return ($loc, $rev, _get_loc_entry($loc));
+            }
+            else {
+                return ($in_loc, $in_rev, _get_loc_entry($in_loc));
+            }
+        }
+        return ($in_loc, $in_rev, _get_loc_entry($in_loc));
+    }
+    return;
+}
+
+################################################################################
+# Returns a list of keyword entries/trailing path pairs for the input location
+sub _get_loc_entry {
+    my ($loc) = @_;
+    if ($loc) {
+        my $uri = URI->new($loc);
+        if (
+               $uri->scheme()
+            && $uri->scheme() eq get_prefix_of_location_keyword()
+        ) {
+            my ($key, $trail) = $uri->opaque() =~ qr{\A ([^/\@]+) (.*) \z}xms;
+            my $entry = get_entries()->get_entry_by_key($key);
+            if (!$entry || !$entry->get_value()) {
+                die(Fcm::Keyword::Exception->new({message => sprintf(
+                    "%s: unknown FCM location keyword", $loc,
+                )}));
+            }
+            $loc = $entry->get_value() . ($trail ? $trail : q{});
+        }
+        my @entry_trail_pairs = ();
+        my $lead = $loc;
+        GET_ENTRY:
+        while ($lead) {
+            my $entry = get_entries()->get_entry_by_value($lead);
+            if ($entry) {
+                my $trail = substr($loc, length($lead));
+                push @entry_trail_pairs, [$entry, $trail];
+            }
+            if (!($lead =~ s{/+ [^/]* \z}{}xms)) {
+                last GET_ENTRY;
+            }
+        }
+        if (@entry_trail_pairs) {
+            return @entry_trail_pairs;
+        }
+        else {
+            return;
+        }
+    }
+    return;
+}
+
+################################################################################
+# If $in_rev, returns (LOC, REV). Otherwise, returns LOC@REV
+sub _unparse_loc {
+    my ($loc, $rev, $in_rev) = @_;
+    if (!$loc) {
+        return;
+    }
+    return ($in_rev ? ($loc, $rev) : join(q{@}, $loc, ($rev ? $rev : ())));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword;
+
+    $loc = Fcm::Keyword::expand('fcm:namespace/path@rev-keyword');
+    $loc = Fcm::Keyword::unexpand('svn://host/namespace/path@1234');
+
+    ($loc, $rev) = Fcm::Keyword::expand('fcm:namespace/path', 'rev-keyword');
+    ($loc, $rev) = Fcm::Keyword::unexpand('svn://host/namespace/path', 1234);
+
+    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path');
+    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path');
+
+    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path@1234');
+    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path@1234');
+
+    $loc = Fcm::Keyword::get_browser_url('fcm:namespace/path', 1234);
+    $loc = Fcm::Keyword::get_browser_url('svn://host/namespace/path', 1234);
+
+    $entries = Fcm::Keyword::get_entries();
+
+=head1 DESCRIPTION
+
+This module contains utilities to expand and unexpand FCM location and revision
+keywords.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item expand($loc)
+
+Expands FCM keywords in $loc and returns the result.
+
+If $loc is a I<fcm> scheme URI, the leading part (before any "/" or "@"
+characters) of the URI opaque is the namespace of a FCM location keyword. This
+is expanded into the actual value. Optionally, $loc can be suffixed with a peg
+revision (an "@" followed by any characters). If a peg revision is a FCM
+revision keyword, it is expanded into the actual revision.
+
+=item expand($loc,$rev)
+
+Same as C<expand($loc)>, but $loc should not contain a peg revision. Returns a
+list containing the expanded version of $loc and $rev.
+
+=item get_browser_url($loc)
+
+Given a repository $loc in a known keyword namespace, returns the corresponding
+URL for the code browser.
+
+Optionally, $loc can be suffixed with a peg revision (an "@" followed by any
+characters).
+
+=item get_browser_url($loc,$rev)
+
+Same as get_browser_url($loc), but the revision should be specified using $rev
+but not pegged with $loc.
+
+=item get_entries([$reset])
+
+Returns the L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object for storing
+location keyword entries. If $reset if true, reloads the entries.
+
+=item get_location_entries_for($loc)
+
+Returns a list of L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>
+objects matching $loc.
+
+=item get_prefix_of_location_keyword($with_delimiter)
+
+Returns the prefix of a FCM location keyword, (currently "fcm"). If
+$with_delimiter is specified and is true, returns the prefix with the delimiter,
+(currently "fcm:").
+
+=item unexpand($loc)
+
+Does the opposite of expand($loc). Returns the FCM location keyword equivalence
+of $loc. If the $loc can be mapped using 2 or more namespaces, the namespace
+that results in the longest substitution is used. Optionally, $loc can be
+suffixed with a peg revision (an "@" followed by any characters). If a peg
+revision is a known revision, it is turned into its corresponding revision
+keyword.
+
+=item unexpand($loc,$rev)
+
+Same as unexpand($loc), but $loc should not contain a peg revision. Returns a
+list containing the unexpanded version of $loc and $rev 
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+Functions in this module may die() with this exception when it fails to expand
+a keyword.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Config|Fcm::Keyword::Config>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
+L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Config.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Config.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Config.pm	(revision 9621)
@@ -0,0 +1,143 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Config;
+
+use Carp;
+use Fcm::Keyword::Entries;
+use Fcm::Keyword::Exception;
+use Fcm::Util::ClassLoader;
+
+our %CONFIG_OF = (
+    LOCATION_ENTRIES => {
+        entry_class => 'Fcm::Keyword::Entry::Location',
+        loaders => [
+            {
+                class => 'Fcm::Keyword::Loader::Config::Location',
+            },
+        ],
+    },
+    REVISION_ENTRIES => {
+        entry_class => 'Fcm::Keyword::Entry',
+        loaders => [
+            {
+                class   => 'Fcm::Keyword::Loader::Config::Revision',
+                options => [{key => 'namespace', valuekey => 'key'}],
+            },
+            {
+                class   => 'Fcm::Keyword::Loader::VC::Revision',
+                options => [{key => 'source', valuekey => 'value'}],
+            },
+        ],
+    },
+);
+
+################################################################################
+# Returns a Fcm::Keyword::Entries object for given configuration
+sub get_entries {
+    my ($context, $args_ref) = @_;
+    if (!exists($CONFIG_OF{$context})) {
+        croak(Fcm::Keyword::Exception->new({message => sprintf(
+            "%s: keyword configuration not found", $context,
+        )}));
+    }
+    my $config_ref = $CONFIG_OF{$context};
+    my @loaders;
+    if (exists($config_ref->{loaders})) {
+        for my $loader_config (@{$config_ref->{loaders}}) {
+            my $class = $loader_config->{class};
+            Fcm::Util::ClassLoader::load($class);
+            my %options;
+            if (exists($loader_config->{options})) {
+                for my $option_ref (@{$loader_config->{options}}) {
+                    my $key = $option_ref->{key};
+                    my $value;
+                    if (exists($option_ref->{value})) {
+                        $value = $option_ref->{value};
+                    }
+                    elsif (
+                           exists($option_ref->{valuekey})
+                        && $args_ref
+                        && ref($args_ref) eq 'HASH'
+                        && exists($args_ref->{$option_ref->{valuekey}})
+                    ) {
+                        $value = $args_ref->{$option_ref->{valuekey}};
+                    }
+                    $options{$key} = $value;
+                }
+            }
+            push @loaders, $class->new(\%options);
+        }
+    }
+    my %entries_options = (
+        (@loaders ? (loaders => \@loaders) : ()),
+        (
+            exists($config_ref->{entry_class})
+            ? (entry_class => $config_ref->{entry_class})
+            : ()
+        ),
+    );
+    return Fcm::Keyword::Entries->new(\%entries_options);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Config
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Config;
+
+=head1 DESCRIPTION
+
+This module stores the default configuration used by modules in the
+L<Fcm::Keyword> family.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item get_entries($context,$args_ref)
+
+Returns a L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object for a given
+$context. If there is no matching $context in the configuration, croak() with a
+L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>. $args_ref is an optional
+argument, which should be a reference to a hash containing a I<key> and a
+I<value> element. It can be used by this function to set up the constructor
+options in the loaders of the returned
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=head1 TO DO
+
+Allow configuration to be changed in runtime.
+
+Convert this module to OO?
+
+Separate configuration from logic if this module becomes any bigger.
+
+Unit tests.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Exception|Fcm::Keyword::Exception>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Entries.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Entries.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Entries.pm	(revision 9621)
@@ -0,0 +1,211 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Entries;
+
+use Carp qw{croak};
+use Fcm::Util::ClassLoader;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless(
+        {
+            entry_class             => 'Fcm::Keyword::Entry',
+            entry_by                => {key => {}, value => {}},
+            has_loaded_entries_from => {},
+            loaders                 => [],
+            ($args_ref && ref($args_ref) eq 'HASH' ? %{$args_ref} : ()),
+        },
+        $class,
+    );
+}
+
+################################################################################
+# Returns the class of entries stored by this entries list
+sub get_entry_class {
+    my ($self) = @_;
+    return $self->{entry_class};
+}
+
+################################################################################
+# Returns all entries
+sub get_all_entries {
+    my ($self) = @_;
+    if (!%{$self->{entry_by}{key}}) {
+        # Nothing set, attempt to load entries
+        $self->load_entries();
+    }
+    if (wantarray()) {
+        return values(%{$self->{entry_by}{key}});
+    }
+    else {
+        return [values(%{$self->{entry_by}{key}})];
+    }
+}
+
+################################################################################
+# Methods: get_entry_by_*
+for my $name (
+    ### Returns an entry with a matching key
+    'key',
+    ### Returns an entry with a matching value
+    'value'
+) {
+    no strict qw{refs};
+    my $method = "get_entry_by_$name";
+    *$method = sub {
+        my ($self, $search_key) = @_;
+        if (!defined($search_key)) {
+            return;
+        }
+        my $sk = ($name eq 'key') ? uc($search_key) : $search_key;
+        if (!exists($self->{entry_by}{$name}{$sk})) {
+            $self->load_entries($name, $sk);
+        }
+        if (exists($self->{entry_by}{$name}{$sk})) {
+            return $self->{entry_by}{$name}{$sk};
+        }
+        else {
+            return;
+        }
+    }
+}
+
+################################################################################
+# Adds an entry
+sub add_entry {
+    my ($self, $key, $value, $args_ref) = @_;
+    Fcm::Util::ClassLoader::load($self->get_entry_class());
+    my $entry = $self->get_entry_class()->new({
+        key   => uc($key),
+        value => $value,
+        ($args_ref && ref($args_ref) eq 'HASH' ? %{$args_ref} : ()),
+    });
+    $self->{entry_by}{key}{uc($key)} = $entry;
+    $self->{entry_by}{value}{$value} = $entry;
+    return $entry;
+}
+
+################################################################################
+# Returns the loaders for this entries list
+sub get_loaders {
+    my ($self) = @_;
+    return (wantarray() ? @{$self->{loaders}} : $self->{loaders});
+}
+
+################################################################################
+# Loads entries using its loaders
+sub load_entries {
+    my ($self, $name, $search_key) = @_;
+    LOADER:
+    for my $loader ($self->get_loaders()) {
+        if ($self->{has_loaded_entries_from}{$loader->get_source()}) {
+            next LOADER;
+        }
+        $self->{has_loaded_entries_from}{$loader->get_source()}
+            = $loader->load_to($self);
+        if ($name && exists($self->{entry_by}{$name}{$search_key})) {
+            last LOADER;
+        }
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Entries
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Entries;
+
+    my $entries = Fcm::Keyword::Entries->new({
+        entry_class => $entry_class,
+        loaders     => \@loaders,
+    });
+    $entry = $entries->get_entry_by_key($key);
+    $entry = $entries->get_entry_by_value($value);
+
+    for my $entry ($entries->get_entries()) {
+        # ...
+    }
+
+    $entries->add_entry($key, $value);
+
+=head1 DESCRIPTION
+
+This module is used to manipulate FCM keyword entries. It is used by
+L<Fcm::Keyword|Fcm::Keyword> to store keyword entries, which are
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({entry_class =E<gt> $entry_class, loaders =E<gt> \@loaders})>
+
+Constructor. The argument should be a reference to hash, where:
+
+I<entry_class> is a string representing the class name of entries in this
+object. The class must be a sub-class of
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>. The default is
+"L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>".
+
+I<loaders> is a reference to an array of
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader> objects, which will be used to
+load entries into this object. The default is an empty array.
+
+=item add_entry($key,$value)
+
+Adds an entry. Returns the added entry. (Keys are converted to uppercases
+automatically.)
+
+=item get_all_entries()
+
+Returns all entries that are currently loaded.
+
+=item get_entry_by_key($key)
+
+Return an entry, whose key matches $key. (Search is case-insensitive.) Returns
+undef if there is no matching entry.
+
+=item get_entry_by_value($value)
+
+Return an entry, whose value matches $value. (Search is case-sensitive.)
+Returns undef if there is no matching entry.
+
+=item get_loaders()
+
+Returns the loaders for loading entries.
+
+=item load_entries()
+
+Loads entries from its loaders, as returned by get_loaders(). This method can
+also be triggered by get_all_entries(), if the entry list is empty, or by
+get_entry_by_key($key) and get_entry_by_value($value) methods, if there is no
+matching entry in the current lookup lists.
+
+=back
+
+=head1 TO DO
+
+Handle duplicated entries in add_entry($key,$value).
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Entry.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Entry.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Entry.pm	(revision 9621)
@@ -0,0 +1,83 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Entry;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    if (!$args_ref) {
+        $args_ref = {};
+    }
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+### Methods: get_*
+for my $name (
+    # Returns the key of this entry
+    'key',
+    # Returns the value of this entry
+    'value',
+) {
+    no strict qw{refs};
+    my $getter = "get_$name";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$name};
+    }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Entry
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Entry;
+
+    $entry = Fcm::Keyword::Entry->new({key => $key, value => $value});
+    $key = $entry->get_key();
+    $value = $entry->get_value();
+
+=head1 DESCRIPTION
+
+An object of this class represents a FCM keyword entry.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({key =E<gt> $key, value =E<gt> $value})>
+
+Constructor.
+
+=item get_key()
+
+Returns the key of this keyword entry.
+
+=item get_value()
+
+Returns the value of this keyword entry.
+
+=back
+
+Simple formatter for displaying an entry.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Entry/Location.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Entry/Location.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Entry/Location.pm	(revision 9621)
@@ -0,0 +1,146 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Entry::Location;
+use base qw{Fcm::Keyword::Entry};
+
+use Fcm::Keyword::Config;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    if (!$args_ref) {
+        $args_ref = {};
+    }
+    $args_ref = {
+        browser_rev_template       => undef,
+        browser_url_template       => undef,
+        implied_entry_list         => [],
+        is_implied                 => 0,
+        location_component_pattern => undef,
+        revision_entries           => Fcm::Keyword::Config::get_entries(
+            'REVISION_ENTRIES', $args_ref,
+        ),
+        %{$args_ref},
+    },
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Methods: get_*
+for my $key (
+    # Returns a template for constructing the browser URL
+    'browser_url_template',
+    # Returns a template for constructing the revision part in the browser URL
+    'browser_rev_template',
+    # Returns a list of entries implied this entry
+    'implied_entry_list',
+    # Returns the component pattern for a location matching this entry
+    'location_component_pattern',
+    # Returns the entries for revision keywords
+    'revision_entries',
+) {
+    no strict qw{refs};
+    my $getter = "get_$key";
+    *$getter = sub {
+        my ($self) = @_;
+        return $self->{$key};
+    }
+}
+
+################################################################################
+# Returns true if this is an implied entry
+sub is_implied {
+    my ($self) = @_;
+    return $self->{is_implied};
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Entry::Location
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Entry::Location;
+
+    $entry = Fcm::Keyword::Entry::Location->new({
+        key => $key, value => $value, # ...
+    });
+
+    $key = $entry->get_key();
+    $value = $entry->get_value();
+    $revision_entries = $entry->get_revision_entries();
+
+=head1 DESCRIPTION
+
+This is a sub-class of L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>. An object of
+this class represents a FCM location keyword entry.
+
+=head1 METHODS
+
+See L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> for inherited methods.
+
+=over 4
+
+=item new($args_ref)
+
+Constructor.
+
+=item get_browser_url_template()
+
+Returns the template string for constructing the browser URL. The string {1},
+{2}, {3}, etc in the template string will be substituted by the components
+captured by the location component pattern and the revision template. See
+C<get_url_component_pattern()> and C<get_browser_rev_template()>.
+
+=item get_browser_rev_template()
+
+Returns the template string for constructing the revision part of the browser
+URL. The string {1} in the template string will be substituted by the revision.
+See C<get_browser_url_template()>.
+
+=item get_implied_entry_list()
+
+Returns a list of entries implied by this entry.
+
+=item get_location_component_pattern()
+
+Returns a regular expression, when matched against the scheme-specific-part in
+the actual URI of a location in the namespace of this keyword entry, will
+capture a list of components, which can then be used to replace the numbered
+fields in the browser URL template. See C<get_browser_url_template()>.
+
+=item get_revision_entries()
+
+Returns a L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing the
+revision keyword entries of this location.
+
+=item is_implied()
+
+Returns true if this is an implied entry.
+
+=back
+
+=head1 TO DO
+
+Introduce a Fcm::Keyword::Config module to store entries constructor setting.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Config|Fcm::Keyword::Config>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Exception.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Exception.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Exception.pm	(revision 9621)
@@ -0,0 +1,42 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Exception;
+use base qw{Fcm::Exception};
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Exception
+
+=head1 SYNOPSIS
+
+    use Carp qw{croak};
+    use Fcm::Keyword::Exception;
+    croak(Fcm::Keyword::Exception->new({message => 'something is wrong'}));
+
+=head1 DESCRIPTION
+
+This class extends L<Fcm::Exception|Fcm::Exception>. This exception is thrown
+on errors associated with the command line interface.
+
+=head1 METHODS
+
+See L<Fcm::Exception|Fcm::Exception> for a list of methods.
+
+=head1 SEE ALSO
+
+L<Fcm::Exception|Fcm::Exception>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Formatter/Entries.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Formatter/Entries.pm	(revision 9621)
@@ -0,0 +1,77 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Formatter::Entries;
+
+use Fcm::Keyword::Formatter::Entry;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class) = @_;
+    return bless(\do{my $annon_scalar}, $class);
+}
+
+################################################################################
+# Formats a keyword entry
+sub format {
+    my ($self, $entries) = @_;
+    my $formatter = Fcm::Keyword::Formatter::Entry->new();
+    my $return = q{};
+    for my $entry (
+        sort {$a->get_key() cmp $b->get_key()}
+        grep {!$_->can('is_implied') || !$_->is_implied()}
+        $entries->get_all_entries()
+    ) {
+        $return .= $formatter->format($entry);
+    }
+    return $return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Formatter::Entries
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Formatter::Entries;
+    $formatter = Fcm::Keyword::Formatter::Entries->new();
+    print($formatter->format($entries));
+
+=head1 DESCRIPTION
+
+An object of this class is used to format a keyword entries object.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item format($entries)
+
+Returns a simple string representation of $entries.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Formatter::Entry|Fcm::Keyword::Formatter::Entry>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Formatter/Entry.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Formatter/Entry.pm	(revision 9621)
@@ -0,0 +1,64 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Formatter::Entry;
+
+################################################################################
+# Constructor
+sub new {
+    my ($class) = @_;
+    return bless(\do{my $annon_scalar}, $class);
+}
+
+################################################################################
+# Formats a keyword entry
+sub format {
+    my ($self, $entry) = @_;
+    return sprintf("%s = %s\n", $entry->get_key(), $entry->get_value());
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Formatter::Entry
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Formatter::Entry;
+    $formatter = Fcm::Keyword::Formatter::Entry->new();
+    print($formatter->format($entry));
+
+=head1 DESCRIPTION
+
+An object of this class is used to format a keyword entry.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item format($entry)
+
+Returns a simple string representation of $entry.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Formatter/Entry/Location.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Formatter/Entry/Location.pm	(revision 9621)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Formatter::Entry::Location;
+use base qw{Fcm::Keyword::Formatter::Entry};
+
+use Fcm::Config;
+use Fcm::Keyword::Formatter::Entries;
+
+################################################################################
+# Formats a keyword entry
+sub format {
+    my ($self, $entry) = @_;
+    my $return = $self->SUPER::format($entry);
+    for my $implied_entry (@{$entry->get_implied_entry_list()}) {
+        $return .= $self->SUPER::format($implied_entry);
+    }
+    if (@{$entry->get_revision_entries()->get_all_entries()}) {
+        my $formatter = Fcm::Keyword::Formatter::Entries->new();
+        $return .= "\n[revision keyword]\n";
+        $return .= $formatter->format($entry->get_revision_entries());
+    }
+    return $return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Formatter::Entry::Location
+
+=head1 SYNOPSIS
+
+    use Fcm::Keyword::Formatter::Entry::Location;
+    $formatter = Fcm::Keyword::Formatter::Entry::Location->new();
+    print($formatter->format($entry));
+
+=head1 DESCRIPTION
+
+An object of this class is used to format the detail in a location keyword entry.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item format($entry)
+
+Returns a string representation of $entry.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Formatter::Entry|Fcm::Keyword::Formatter::Entry>,
+L<Fcm::Keyword::Formatter::Entries|Fcm::Keyword::Formatter::Entries>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Loader.pod
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Loader.pod	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Loader.pod	(revision 9621)
@@ -0,0 +1,43 @@
+=head1 NAME
+
+Fcm::Keyword::Loader
+
+=head1 SYNOPSIS
+
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+This is an interface of a class that loads FCM keywords into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object.
+
+=head1 METHODS
+
+=over 4
+
+=item get_source()
+
+The name of the source where this loader loads its FCM keywords from.
+
+=item load_to($entries)
+
+Loads FCM keywords into $entries, which should be a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object. Returns the number of
+successfully loaded entries.
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Loader::Config::Location|Fcm::Keyword::Loader::Config::Location>,
+L<Fcm::Keyword::Loader::Config::Revision|Fcm::Keyword::Loader::Config::Revision>,
+L<Fcm::Keyword::Loader::VC::Revision|Fcm::Keyword::Loader::VC::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Loader/Config/Location.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Loader/Config/Location.pm	(revision 9621)
@@ -0,0 +1,128 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Loader::Config::Location;
+
+use Fcm::Config;
+
+my %IMPLIED_NAMESPACE_SUFFIX = (tr => 'trunk', br => 'branches', tg => 'tags');
+
+sub new {
+    my ($class) = @_;
+    return bless(\do{my $annon_scalar}, $class);
+}
+
+################################################################################
+# Returns 'Fcm::Config'
+sub get_source {
+    my ($self) = @_;
+    return 'Fcm::Config';
+}
+
+################################################################################
+# Loads location keywords from Fcm::Config to $entries
+sub load_to {
+    my ($self, $entries) = @_;
+    my $config = $self->get_source()->instance();
+    my $load_counter = 0;
+    for my $key (keys(%{$config->setting('URL')})) {
+        my $value = $config->setting('URL', $key);
+        my $location_component_pattern = $config->setting(
+            'URL_BROWSER_MAPPING', $key, 'LOCATION_COMPONENT_PATTERN');
+        my $browser_url_template = $config->setting(
+            'URL_BROWSER_MAPPING', $key, 'BROWSER_URL_TEMPLATE');
+        my $browser_rev_template = $config->setting(
+            'URL_BROWSER_MAPPING', $key, 'BROWSER_REV_TEMPLATE');
+        my $entry = $entries->add_entry(
+            $key,
+            $value,
+            {
+                location_component_pattern => $location_component_pattern,
+                browser_url_template       => $browser_url_template,
+                browser_rev_template       => $browser_rev_template,
+            },
+        );
+        $load_counter++;
+
+        # Set up implied keywords
+        for my $suffix (keys(%IMPLIED_NAMESPACE_SUFFIX)) {
+            my $value_suf = $value . '/' . $IMPLIED_NAMESPACE_SUFFIX{$suffix};
+            for my $join (q{_}, q{-}) {
+                my $implied_entry = $entries->add_entry(
+                    uc($key . $join . $suffix),
+                    $value_suf,
+                    {is_implied => 1},
+                );
+                push(@{$entry->get_implied_entry_list()}, $implied_entry);
+                $load_counter++;
+            }
+        }
+    }
+    return ($config->is_initialising() ? 0 : defined($load_counter));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Loader::Config::Location
+
+=head1 SYNOPSIS
+
+    $loader = Fcm::Keyword::Loader::Config::Location->new();
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+This class implements the L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>
+interface.
+
+Loads location keywords from L<Fcm::Config|Fcm::Config> into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item new()
+
+Constructor.
+
+=item get_source()
+
+Returns the string "L<Fcm::Config|Fcm::Config>".
+
+=item load_to($entries)
+
+Loads location keywords and implied keywords from L<Fcm::Config|Fcm::Config> to
+$entries. It also loads settings for mapping location to browser URL. Returns
+true on success. (However, if L<Fcm::Config|Fcm::Config> is initialising,
+returns false to force a reload next time.)
+
+=back
+
+=head1 TO DO
+
+Need a more flexible system for implied keywords.
+
+=head1 SEE ALSO
+
+L<Fcm::Config|Fcm::Config>,
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>,
+L<Fcm::Keyword::Loader::Config::Revision|Fcm::Keyword::Loader::Config::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Loader/Config/Revision.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Loader/Config/Revision.pm	(revision 9621)
@@ -0,0 +1,110 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Loader::Config::Revision;
+
+use Fcm::Config;
+
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns the namespace where the revision keywords belong
+sub get_namespace {
+    my ($self) = @_;
+    return $self->{namespace};
+}
+
+################################################################################
+# Returns 'Fcm::Config'
+sub get_source {
+    my ($self) = @_;
+    return 'Fcm::Config';
+}
+
+################################################################################
+# Loads revision keywords from Fcm::Config to $entries
+sub load_to {
+    my ($self, $entries) = @_;
+    my $load_counter = 0;
+    my $config = $self->get_source()->instance();
+    my $rev_keyword_ref = $config->setting(
+        qw/URL_REVISION/,
+        uc($self->get_namespace()),
+    );
+    if ($rev_keyword_ref) {
+        for my $key (keys(%{$rev_keyword_ref})) {
+            $entries->add_entry($key, $rev_keyword_ref->{$key});
+            $load_counter++;
+        }
+    }
+    return ($config->is_initialising() ? 0 : defined($load_counter));
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Loader::Config::Revision
+
+=head1 SYNOPSIS
+
+    $loader = Fcm::Keyword::Loader::Config::Revision->new({namespace => $name});
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+Loads revision keywords from L<Fcm::Config|Fcm::Config> into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({namespace =E<gt> $namespace})>
+
+Constructor. The argument $namespace is the namespace where the revision
+keywords belong.
+
+=item get_namespace()
+
+Returns the namespace where the revision keywords belong.
+
+=item get_source()
+
+Returns the string "L<Fcm::Config|Fcm::Config>".
+
+=item load_to($entries)
+
+Loads revision keywords in the namespace given by C<$self-E<gt>get_namespace()>
+from L<Fcm::Config|Fcm::Config> to $entries. Returns true on success. (However,
+if L<Fcm::Config|Fcm::Config> is initialising, returns false to force a reload
+next time.)
+
+=back
+
+=head1 SEE ALSO
+
+L<Fcm::Config|Fcm::Config>,
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>,
+L<Fcm::Keyword::Loader::Config::Location|Fcm::Keyword::Loader::Config::Location>
+L<Fcm::Keyword::Loader::VC::Revision|Fcm::Keyword::Loader::VC::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/Keyword/Loader/VC/Revision.pm
===================================================================
--- vendors/FCM/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Keyword/Loader/VC/Revision.pm	(revision 9621)
@@ -0,0 +1,103 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Keyword::Loader::VC::Revision;
+
+use Fcm::Util qw{run_command};
+
+sub new {
+    my ($class, $args_ref) = @_;
+    return bless({%{$args_ref}}, $class);
+}
+
+################################################################################
+# Returns the VC location where revision keywords will be loaded from
+sub get_source {
+    my ($self) = @_;
+    return $self->{source};
+}
+
+################################################################################
+# Loads revision keywords from $self->get_source() to $entries
+sub load_to {
+    my ($self, $entries) = @_;
+    my @lines = run_command(
+        [qw{svn pg fcm:revision}, $self->get_source()],
+        DEVNULL => 1,
+        ERROR   => 'ignore',
+        METHOD  => 'qx',
+    );
+    my $load_counter = 0;
+    for my $line (@lines) {
+        chomp($line);
+        my ($key, $value) = split(qr{\s+ = \s+}xms, $line);
+        if ($key && $value) {
+            $entries->add_entry($key, $value);
+            $load_counter++;
+        }
+    }
+    return defined($load_counter);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::Keyword::Loader::VC::Revision
+
+=head1 SYNOPSIS
+
+    $loader = Fcm::Keyword::Loader::VC::Revision->new({source => $source});
+    $loader->load_to($entries);
+
+=head1 DESCRIPTION
+
+Loads revision keywords from a VC location into a
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries> object containing
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry> objects.
+
+=head1 METHODS
+
+=over 4
+
+=item C<new({source =E<gt> $source})>
+
+Constructor. The argument $source is the VC location from which revision
+keywords will be loaded from.
+
+=item get_source()
+
+Returns the source VC location from which revision keywords will be loaded
+from.
+
+=item load_to($entries)
+
+Loads revision keywords from C<$self-E<gt>get_source()> to $entries.
+
+=back
+
+=head1 TO DO
+
+Abstract away the call to the VC system, which assumes the Subversion shell
+client at the moment.
+
+=head1 SEE ALSO
+
+L<Fcm::Keyword|Fcm::Keyword>,
+L<Fcm::Keyword::Entries|Fcm::Keyword::Entries>,
+L<Fcm::Keyword::Entry|Fcm::Keyword::Entry>,
+L<Fcm::Keyword::Entry::Location|Fcm::Keyword::Entry::Location>,
+L<Fcm::Keyword::Loader|Fcm::Keyword::Loader>,
+L<Fcm::Keyword::Loader::Config::Revision|Fcm::Keyword::Loader::Config::Revision>
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/lib/Fcm/ReposBranch.pm
===================================================================
--- vendors/FCM/lib/Fcm/ReposBranch.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/ReposBranch.pm	(revision 9621)
@@ -0,0 +1,506 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::ReposBranch
+#
+# DESCRIPTION
+#   This class contains methods for gathering information for a repository
+#   branch. It currently supports Subversion repository and local user
+#   directory.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package Fcm::ReposBranch;
+use base qw{Fcm::Base};
+
+use Fcm::CfgLine;
+use Fcm::Keyword;
+use Fcm::Util      qw{expand_tilde is_url run_command w_report};
+use File::Basename qw{dirname};
+use File::Find     qw{find};
+use File::Spec;
+
+# List of scalar property methods for this class
+my @scalar_properties = (
+  'package',  # package name of which this repository belongs
+  'repos',    # repository branch root URL/path
+  'revision', # the revision of this branch
+  'tag',      # "tag" name of this branch of the repository
+  'type',     # repository type
+);
+
+# List of hash property methods for this class
+my @hash_properties = (
+  'dirs',    # list of non-recursive directories in this branch
+  'expdirs', # list of recursive directories in this branch
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::ReposBranch->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::ReposBranch class. See
+#   @scalar_properties above for allowed list of properties in the constructor.
+#   (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  $self->{$_} = {} for (@hash_properties);
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    return $self->{$name};
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %hash = %{ $obj->X () };
+#   $obj->X (\%hash);
+#
+#   $value = $obj->X ($index);
+#   $obj->X ($index, $value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @hash_properties.
+#
+#   If no argument is set, this method returns a hash containing a list of
+#   objects. If an argument is set and it is a reference to a hash, the objects
+#   are replaced by the the specified hash.
+#
+#   If a scalar argument is specified, this method returns a reference to an
+#   object, if the indexed object exists or undef if the indexed object does
+#   not exist. If a second argument is set, the $index element of the hash will
+#   be set to the value of the argument.
+# ------------------------------------------------------------------------------
+
+for my $name (@hash_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my ($self, $arg1, $arg2) = @_;
+
+    # Ensure property is defined as a reference to a hash
+    $self->{$name} = {} if not defined ($self->{$name});
+
+    # Argument 1 can be a reference to a hash or a scalar index
+    my ($index, %hash);
+
+    if (defined $arg1) {
+      if (ref ($arg1) eq 'HASH') {
+        %hash = %$arg1;
+
+      } else {
+        $index = $arg1;
+      }
+    }
+
+    if (defined $index) {
+      # A scalar index is defined, set and/or return the value of an element
+      $self->{$name}{$index} = $arg2 if defined $arg2;
+
+      return (
+        exists $self->{$name}{$index} ? $self->{$name}{$index} : undef
+      );
+
+    } else {
+      # A scalar index is not defined, set and/or return the hash
+      $self->{$name} = \%hash if defined $arg1;
+      return $self->{$name};
+    }
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_revision;
+#
+# DESCRIPTION
+#   This method expands the revision keywords of the current branch to a
+#   revision number. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_revision {
+  my $self = shift;
+
+  my $rc = 1;
+  if ($self->type eq 'svn') {
+    # Expand revision keyword
+    my $rev = (Fcm::Keyword::expand($self->repos(), $self->revision()))[1];
+
+    # Get last changed revision of the specified revision
+    my $info_ref = $self->_svn_info($self->repos(), $rev);
+    if (!defined($info_ref->{'Revision'})) {
+      my $url = $self->repos() . ($rev ? '@' . $rev : q{});
+      w_report("ERROR: $url: not a valid URL\n");
+      return 0;
+    }
+    my $lc_rev = $info_ref->{'Last Changed Rev'};
+    $rev       = $info_ref->{'Revision'};
+
+    # Print info if specified revision is not the last commit revision
+    if (uc($self->revision()) ne 'HEAD' && $lc_rev != $rev) {
+      my $message = $self->repos . '@' . $rev . ': last changed at [' .
+                    $lc_rev . '].';
+      if ($self->setting ('EXT_REVMATCH') and uc ($self->revision) ne 'HEAD') {
+        w_report "ERROR: specified and last changed revisions differ:\n",
+                 '       ', $message, "\n";
+        $rc = 0;
+
+      } else {
+        print 'INFO: ', $message, "\n";
+      }
+    }
+
+    if ($self->verbose > 1 and uc ($self->revision) ne 'HEAD') {
+      # See if there is a later change of the branch at the HEAD
+      my $head_lc_rev = $self->_svn_info($self->repos())->{'Last Changed Rev'};
+
+      if (defined($head_lc_rev) && $head_lc_rev != $lc_rev) {
+        # Ensure that this is the same branch by checking its history
+        my @lines = &run_command (
+          [qw/svn log -q --incremental -r/, $lc_rev, $self->repos . '@HEAD'],
+          METHOD => 'qx', TIME => $self->verbose > 2,
+        );
+
+        print 'INFO: ', $self->repos, '@', $rev,
+              ': newest commit at [', $head_lc_rev, '].', "\n"
+          if @lines;
+      }
+    }
+
+    $self->revision ($rev) if $rev ne $self->revision;
+
+  } elsif ($self->type eq 'user') {
+    1; # Do nothing
+
+  } else {
+    w_report 'ERROR: ', $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_path;
+#
+# DESCRIPTION
+#   This method expands the relative path names of sub-directories to full
+#   path names. It returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_path {
+  my $self = shift;
+
+  my $rc = 1;
+  if ($self->type eq 'svn') {
+    # SVN repository
+    # Do nothing unless there is a declared repository for this branch
+    return unless $self->repos;
+
+    # Remove trailing /
+    my $repos = $self->repos;
+    $self->repos ($repos) if $repos =~ s#/+$##;
+
+    # Consider all declared (expandable) sub-directories
+    for my $name (qw/dirs expdirs/) {
+      for my $dir (keys %{ $self->$name }) {
+        # Do nothing if declared sub-directory is quoted as a full URL
+        next if &is_url ($self->$name ($dir));
+
+        # Expand sub-directory to full URL
+        $self->$name ($dir, $self->repos . (
+          $self->$name ($dir) ? ('/' . $self->$name ($dir)) : ''
+        ));
+      }
+    }
+    # Note: "catfile" cannot be used in the above statement because it has
+    #       the tendency of removing a slash from double slashes.
+
+  } elsif ($self->type eq 'user') {
+    # Local user directories
+
+    # Expand leading ~ for all declared (expandable) sub-directories
+    for my $name (qw/dirs expdirs/) {
+      for my $dir (keys %{ $self->$name }) {
+        $self->$name ($dir, expand_tilde $self->$name ($dir));
+      }
+    }
+
+    # A top directory for the source is declared
+    if ($self->repos) {
+      # Expand leading ~ for the top directory
+      $self->repos (expand_tilde $self->repos);
+
+      # Get the root directory of the file system
+      my $rootdir = File::Spec->rootdir ();
+
+      # Expand top directory to absolute path, if necessary
+      $self->repos (File::Spec->rel2abs ($self->repos))
+        if $self->repos !~ m/^$rootdir/;
+
+      # Remove trailing /
+      my $repos = $self->repos;
+      $self->repos ($repos) if $repos =~ s#/+$##;
+
+      # Consider all declared (expandable) sub-directories
+      for my $name (qw/dirs expdirs/) {
+        for my $dir (keys %{ $self->$name }) {
+          # Do nothing if declared sub-directory is quoted as a full path
+          next if $self->$name ($dir) =~ m#^$rootdir#;
+
+          # Expand sub-directory to full path
+          $self->$name (
+            $dir, $self->$name ($dir)
+                  ? File::Spec->catfile ($self->repos, $self->$name ($dir))
+                  : $self->repos
+          );
+        }
+      }
+    }
+
+  } else {
+    w_report 'ERROR: ', $self->repos, ': repository type "', $self->type,
+             '" not supported.';
+    $rc = 0;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->expand_all();
+#
+# DESCRIPTION
+#   This method searches the expandable source directories recursively for
+#   source directories containing regular files. The namespaces and the locators
+#   of these sub-directories are then added to the source directory hash table.
+#   Returns true on success.
+# ------------------------------------------------------------------------------
+
+sub expand_all {
+  my ($self) = @_;
+  my %finder_of = (
+    user => sub {
+      my ($root_locator) = @_;
+      my %ns_of;
+      my $wanted = sub {
+        my $base_name = $_;
+        my $path = $File::Find::name;
+        if (-f $path && -r $path && !-l $path) {
+          my $dir_path      = dirname($path);
+          my $rel_dir_path  = File::Spec->abs2rel($dir_path, $root_locator);
+          if (!exists($ns_of{$dir_path})) {
+            $ns_of{$dir_path} = [File::Spec->splitdir($rel_dir_path)];
+          }
+        }
+      };
+      find($wanted, $root_locator);
+      return \%ns_of;
+    },
+    svn  => sub {
+      my ($root_locator) = @_;
+      my $runner = sub {
+        map {chomp($_); $_} run_command(
+          ['svn', @_,  '-R', join('@', $root_locator, $self->revision())],
+          METHOD => 'qx', TIME => $self->config()->verbose() > 2,
+        );
+      };
+      # FIXME: check for symlink switched off due to "svn pg" being very slow
+      #my %symlink_in
+      #  = map {($_ =~ qr{\A(.+)\s-\s(\*)\z}xms)} ($runner->(qw{pg svn:special}));
+      #my @locators
+      #  = grep {$_ !~ qr{/\z}xms && !$symlink_in{$_}} ($runner->('ls'));
+      my @locators = grep {$_ !~ qr{/\z}xms} ($runner->('ls'));
+      my %ns_of;
+      for my $locator (@locators) {
+        my ($rel_dir_locator) = $locator =~ qr{\A(.*)/[^/]+\z}xms; # dirname
+        $rel_dir_locator ||= q{};
+        my $dir_locator = join(q{/}, $root_locator, $rel_dir_locator);
+        if (!exists($ns_of{$dir_locator})) {
+          $ns_of{$dir_locator} = [split(q{/}, $rel_dir_locator)];
+        }
+      }
+      return \%ns_of;
+    },
+  );
+
+  if (!defined($finder_of{$self->type()})) {
+    w_report(sprintf(
+        qq{ERROR: %s: resource type "%s" not supported},
+        $self->repos(),
+        $self->type(),
+    ));
+    return;
+  }
+  while (my ($root_ns, $root_locator) = each(%{$self->expdirs()})) {
+    my @root_ns_list = split(qr{$Fcm::Config::DELIMITER}xms, $root_ns);
+    my $ns_hash_ref = $finder_of{$self->type()}->($root_locator);
+    while (my ($dir_path, $ns_list_ref) = each(%{$ns_hash_ref})) {
+      if (!grep {$_ =~ qr{\A\.}xms || $_ =~ qr{~\z}xms} @{$ns_list_ref}) {
+        my $ns = join($Fcm::Config::DELIMITER, @root_ns_list, @{$ns_list_ref});
+        $self->dirs($ns, $dir_path);
+      }
+    }
+  }
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $n = $obj->add_base_dirs ($base);
+#
+# DESCRIPTION
+#   Add a list of source directories to the current branch based on the set
+#   provided by $base, which must be a reference to a Fcm::ReposBranch
+#   instance. It returns the total number of used sub-directories in the
+#   current repositories.
+# ------------------------------------------------------------------------------
+
+sub add_base_dirs {
+  my $self = shift;
+  my $base = shift;
+
+  my %base_dirs = %{ $base->dirs };
+
+  for my $key (keys %base_dirs) {
+    # Remove repository root from base directories
+    if ($base_dirs{$key} eq $base->repos) {
+      $base_dirs{$key} = '';
+
+    } else {
+      $base_dirs{$key} = substr $base_dirs{$key}, length ($base->repos) + 1;
+    }
+
+    # Append base directories to current repository root
+    $self->dirs ($key, $base_dirs{$key});
+  }
+
+  # Expand relative path names of sub-directories
+  $self->expand_path;
+
+  return scalar keys %{ $self->dirs };
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @cfglines = $obj->to_cfglines ();
+#
+# DESCRIPTION
+#   This method returns a list of configuration lines for the current branch.
+# ------------------------------------------------------------------------------
+
+sub to_cfglines {
+  my ($self) = @_;
+  my @return = ();
+
+  my $suffix = $self->package . $Fcm::Config::DELIMITER . $self->tag;
+  push @return, Fcm::CfgLine->new (
+    label => $self->cfglabel ('REPOS') . $Fcm::Config::DELIMITER . $suffix,
+    value => $self->repos,
+  ) if $self->repos;
+
+  push @return, Fcm::CfgLine->new (
+    label => $self->cfglabel ('REVISION') . $Fcm::Config::DELIMITER . $suffix,
+    value => $self->revision,
+  ) if $self->revision;
+
+  for my $key (sort keys %{ $self->dirs }) {
+    my $value = $self->dirs ($key);
+
+    # Use relative path where possible
+    if ($self->repos) {
+      if ($value eq $self->repos) {
+        $value = '';
+
+      } elsif (index ($value, $self->repos) == 0) {
+        $value = substr ($value, length ($self->repos) + 1);
+      }
+    }
+
+    # Use top package name where possible
+    my $dsuffix = $key . $Fcm::Config::DELIMITER . $self->tag;
+    $dsuffix = $suffix if $value ne $self->dirs ($key) and $key eq join (
+      $Fcm::Config::DELIMITER, $self->package, File::Spec->splitdir ($value)
+    );
+
+    push @return, Fcm::CfgLine->new (
+      label => $self->cfglabel ('DIRS') . $Fcm::Config::DELIMITER . $dsuffix,
+      value => $value,
+    );
+  }
+
+  push @return, Fcm::CfgLine->new ();
+
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   my $hash_ref = $self->_svn_info($url[, $rev]);
+#
+# DESCRIPTION
+#   Executes "svn info" and returns each field in a hash.
+# ------------------------------------------------------------------------------
+sub _svn_info {
+  my ($self, $url, $rev) = @_;
+  return {
+    map {
+      chomp();
+      my ($key, $value) = split(qr{\s*:\s*}xms, $_, 2);
+      $key ? ($key, $value) : ();
+    } run_command(
+      [qw{svn info}, ($rev ? ('-r', $rev, join('@', $url, $rev)) : $url)], 
+      DEVNULL => 1, METHOD => 'qx', TIME => $self->verbose() > 2,
+    )
+  };
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/SrcDirLayer.pm
===================================================================
--- vendors/FCM/lib/Fcm/SrcDirLayer.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/SrcDirLayer.pm	(revision 9621)
@@ -0,0 +1,264 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::SrcDirLayer
+#
+# DESCRIPTION
+#   This class contains methods to manipulate the extract of a source
+#   directory from a branch of a (Subversion) repository.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use warnings;
+use strict;
+
+package Fcm::SrcDirLayer;
+use base qw{Fcm::Base};
+
+use Fcm::Util      qw{run_command e_report w_report};
+use File::Basename qw{dirname};
+use File::Path     qw{mkpath};
+use File::Spec;
+
+# List of property methods for this class
+my @scalar_properties = (
+  'cachedir',  # cache directory for this directory branch
+  'commit',    # revision at which the source directory was changed
+  'extracted', # is this branch already extracted?
+  'files',     # list of source files in this directory branch
+  'location',  # location of the source directory in the branch
+  'name',      # sub-package name of the source directory
+  'package',   # top level package name of which the current repository belongs
+  'reposroot', # repository root URL
+  'revision',  # revision of the repository branch
+  'tag',       # package/revision tag of the current repository branch
+  'type',      # type of the repository branch ("svn" or "user")
+);
+
+my %ERR_MESS_OF = (
+    CACHE_WRITE => '%s: cannot write to cache',
+    SYMLINK     => '%s/%s: ignore symbolic link',
+    VC_TYPE     => '%s: repository type not supported',
+);
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $obj = Fcm::SrcDirLayer->new (%args);
+#
+# DESCRIPTION
+#   This method constructs a new instance of the Fcm::SrcDirLayer class. See
+#   above for allowed list of properties. (KEYS should be in uppercase.)
+# ------------------------------------------------------------------------------
+
+sub new {
+  my $this  = shift;
+  my %args  = @_;
+  my $class = ref $this || $this;
+
+  my $self = Fcm::Base->new (%args);
+
+  for (@scalar_properties) {
+    $self->{$_} = exists $args{uc ($_)} ? $args{uc ($_)} : undef;
+  }
+
+  bless $self, $class;
+  return $self;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $value = $obj->X;
+#   $obj->X ($value);
+#
+# DESCRIPTION
+#   Details of these properties are explained in @scalar_properties.
+# ------------------------------------------------------------------------------
+
+for my $name (@scalar_properties) {
+  no strict 'refs';
+
+  *$name = sub {
+    my $self = shift;
+
+    # Argument specified, set property to specified argument
+    if (@_) {
+      $self->{$name} = $_[0];
+    }
+
+    # Default value for property
+    if (not defined $self->{$name}) {
+      if ($name eq 'files') {
+        # Reference to an array
+        $self->{$name} = [];
+      }
+    }
+
+    return $self->{$name};
+  }
+}
+
+# Handles error/warning events.
+sub _err {
+    my ($key, $args_ref, $warn_only) = @_;
+    my $reporter = $warn_only ? \&w_report : \&e_report;
+    $args_ref ||= [];
+    $reporter->(sprintf($ERR_MESS_OF{$key} . ".\n", @{$args_ref}));
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $dir = $obj->localdir;
+#
+# DESCRIPTION
+#   This method returns the user or cache directory for the current revision
+#   of the repository branch.
+# ------------------------------------------------------------------------------
+
+sub localdir {
+  my $self = shift;
+
+  return $self->user ? $self->location : $self->cachedir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $user = $obj->user;
+#
+# DESCRIPTION
+#   This method returns the string "user" if the current source directory
+#   branch is a local directory. Otherwise, it returns "undef".
+# ------------------------------------------------------------------------------
+
+sub user {
+  my $self = shift;
+
+  return $self->type eq 'user' ? 'user' : undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rev = $obj->get_commit;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to obtain
+#   the revision in which the branch is last committed. On a successful
+#   operation, it returns this revision number. Otherwise, it returns
+#   "undef".
+# ------------------------------------------------------------------------------
+
+sub get_commit {
+  my $self = shift;
+
+  if ($self->type eq 'svn') {
+    # Execute the "svn info" command
+    my @lines   = &run_command (
+      [qw/svn info -r/, $self->revision, $self->location . '@' . $self->revision],
+      METHOD => 'qx', TIME => $self->config->verbose > 2,
+    );
+
+    my $rev;
+    for (@lines) {
+      if (/^Last\s+Changed\s+Rev\s*:\s*(\d+)/i) {
+        $rev = $1;
+        last;
+      }
+    }
+
+    # Commit revision of this source directory
+    $self->commit ($rev);
+
+    return $self->commit;
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    _err('VC_TYPE', [$self->type()]);
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = $obj->update_cache;
+#
+# DESCRIPTION
+#   If the current repository type is "svn", this method attempts to extract
+#   the current revision source directory from the current branch from the
+#   repository, sending the output to the cache directory. It returns true on
+#   a successful operation, or false if the repository is not of type "svn".
+# ------------------------------------------------------------------------------
+
+sub update_cache {
+  my $self = shift;
+
+  return unless $self->cachedir;
+
+  # Create cache extract destination, if necessary
+  my $dirname = dirname $self->cachedir;
+  mkpath($dirname);
+
+  if (!-w $dirname) {
+    _err('CACHE_WRITE', [$dirname]);
+  }
+  
+  if ($self->type eq 'svn') {
+    # Set up the extract command, "svn export --force -q -N"
+    my @command = (
+      qw/svn export --force -q -N/,
+      $self->location . '@' . $self->revision,
+      $self->cachedir,
+    );
+
+    &run_command (\@command, TIME => $self->config->verbose > 2);
+
+  } elsif ($self->type eq 'user') {
+    return;
+
+  } else {
+    _err('VC_TYPE', [$self->type()]);
+  }
+
+  return 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @files = $obj->get_files();
+#
+# DESCRIPTION
+#   This method returns a list of file base names in the (cache of) this source
+#   directory in the current branch.
+# ------------------------------------------------------------------------------
+
+sub get_files {
+  my ($self) = @_;
+  opendir(my $dir, $self->localdir())
+    || die($self->localdir(), ': cannot read directory');
+  my @base_names = ();
+  BASE_NAME:
+  while (my $base_name = readdir($dir)) {
+    if ($base_name =~ qr{\A\.}xms || $base_name =~ qr{~\z}xms) {
+        next BASE_NAME;
+    }
+    my $path = File::Spec->catfile($self->localdir(), $base_name);
+    if (-d $path) {
+        next BASE_NAME;
+    }
+    if (-l $path) {
+        _err('SYMLINK', [$self->location(), $base_name], 1);
+        next BASE_NAME;
+    }
+    push(@base_names, $base_name);
+  }
+  closedir($dir);
+  $self->files(\@base_names);
+  return @base_names;
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Timer.pm
===================================================================
--- vendors/FCM/lib/Fcm/Timer.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Timer.pm	(revision 9621)
@@ -0,0 +1,72 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Timer
+#
+# DESCRIPTION
+#   This is a package of timer utility used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+package Fcm::Timer;
+
+# Standard pragma
+use warnings;
+use strict;
+
+# Exports
+our (@ISA, @EXPORT, @EXPORT_OK);
+
+sub timestamp_command;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(timestamp_command);
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %cmd_start_time = (); # Command start time, (key = command, value = time)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &Fcm::Timer::timestamp_command ($command[, $status]);
+#
+# DESCRIPTION
+#   This function returns a string adding to $command a prefix according the
+#   value of $status. If $status is not specified or does not match the word
+#   "end", the status is assumed to be "start". At "start", the prefix will
+#   contain the current timestamp. If $status is the word "end", the prefix
+#   will contain the total time taken since this function was called with the
+#   same $command at the "start" status.
+# ------------------------------------------------------------------------------
+
+sub timestamp_command {
+  (my $command, my $status) = @_;
+
+  my $prefix;
+  if ($status and $status =~ /end/i) {
+    # Status is "end", insert time taken
+    my $lapse = time () - $cmd_start_time{$command};
+    $prefix = sprintf "# Time taken: %12d s=> ", $lapse;
+
+  } else {
+    # Status is "start", insert time stamp
+    $cmd_start_time{$command} = time;
+
+    (my $sec, my $min, my $hour, my $mday, my $mon, my $year) = localtime;
+    $prefix = sprintf "# Start: %04d-%02d-%02d %02d:%02d:%02d=> ",
+              $year + 1900, $mon + 1, $mday, $hour, $min, $sec;
+  }
+
+  return $prefix . $command . "\n";
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Util.pm
===================================================================
--- vendors/FCM/lib/Fcm/Util.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Util.pm	(revision 9621)
@@ -0,0 +1,552 @@
+# ------------------------------------------------------------------------------
+# NAME
+#   Fcm::Util
+#
+# DESCRIPTION
+#   This is a package of misc utilities used by the FCM command.
+#
+# COPYRIGHT
+#   (C) Crown copyright Met Office. All rights reserved.
+#   For further details please refer to the file COPYRIGHT.txt
+#   which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use warnings;
+use strict;
+
+package Fcm::Util;
+require Exporter;
+our @ISA = qw{Exporter};
+
+sub expand_tilde;
+sub e_report;
+sub find_file_in_path;
+sub get_command_string;
+sub get_rev_of_wc;
+sub get_url_of_wc;
+sub get_url_peg_of_wc;
+sub get_wct;
+sub is_url;
+sub is_wc;
+sub print_command;
+sub run_command;
+sub svn_date;
+sub tidy_url;
+sub touch_file;
+sub w_report;
+
+our @EXPORT = qw{
+    expand_tilde
+    e_report
+    find_file_in_path
+    get_command_string
+    get_rev_of_wc
+    get_url_of_wc
+    get_url_peg_of_wc
+    get_wct
+    is_url
+    is_wc
+    print_command
+    run_command
+    svn_date
+    tidy_url
+    touch_file
+    w_report
+};
+
+# Standard modules
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Find;
+use File::Path;
+use File::Spec;
+use POSIX qw{strftime SIGINT SIGKILL SIGTERM WEXITSTATUS WIFSIGNALED WTERMSIG};
+
+# FCM component modules
+use Fcm::Timer;
+
+# ------------------------------------------------------------------------------
+
+# Module level variables
+my %svn_info       = (); # "svn info" log, (key1 = path,
+                         # key2 = URL, Revision, Last Changed Rev)
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   %srcdir = &Fcm::Util::find_file_in_path ($file, \@path);
+#
+# DESCRIPTION
+#   Search $file in @path. Returns the full path of the $file if it is found
+#   in @path. Returns "undef" if $file is not found in @path.
+# ------------------------------------------------------------------------------
+
+sub find_file_in_path {
+  my ($file, $path) = @_;
+
+  for my $dir (@$path) {
+    my $full_file = File::Spec->catfile ($dir, $file);
+    return $full_file if -e $full_file;
+  }
+
+  return undef;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $expanded_path = &Fcm::Util::expand_tilde ($path);
+#
+# DESCRIPTION
+#   Returns an expanded path if $path is a path that begins with a tilde (~).
+# ------------------------------------------------------------------------------
+
+sub expand_tilde {
+  my $file = $_[0];
+
+  $file =~ s#^~([^/]*)#$1 ? (getpwnam $1)[7] : ($ENV{HOME} || $ENV{LOGDIR})#ex;
+
+  # Expand . and ..
+  while ($file =~ s#/+\.(?:/+|$)#/#g) {next}
+  while ($file =~ s#/+[^/]+/+\.\.(?:/+|$)#/#g) {next}
+
+  # Remove trailing /
+  $file =~ s#/*$##;
+
+  return $file;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $rc = &Fcm::Util::touch_file ($file);
+#
+# DESCRIPTION
+#   Touch $file if it exists. Create $file if it does not exist. Return 1 for
+#   success or 0 otherwise.
+# ------------------------------------------------------------------------------
+
+sub touch_file {
+  my $file = $_[0];
+  my $rc   = 1;
+
+  if (-e $file) {
+    my $now = time;
+    $rc = utime $now, $now, $file;
+
+  } else {
+    mkpath dirname ($file) unless -d dirname ($file);
+
+    $rc = open FILE, '>', $file;
+    $rc = close FILE if $rc;
+  }
+
+  return $rc;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_wc ([$path]);
+#
+# DESCRIPTION
+#   Returns true if current working directory (or $path) is a Subversion
+#   working copy.
+# ------------------------------------------------------------------------------
+
+sub is_wc {
+  my $path = @_ ? $_[0] : cwd ();
+
+  if (-d $path) {
+    return (-e File::Spec->catfile ($path, qw/.svn format/)) ? 1 : 0;
+
+  } elsif (-f $path) {
+    return (-e File::Spec->catfile (dirname ($path), qw/.svn format/)) ? 1 : 0;
+
+  } else {
+    return 0;
+  }
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $flag = &is_url ($url);
+#
+# DESCRIPTION
+#   Returns true if $url is a URL.
+# ------------------------------------------------------------------------------
+
+sub is_url {
+  # This should handle URL beginning with svn://, http:// and svn+ssh://
+  return ($_[0] =~ m#^[\+\w]+://#);
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $url = tidy_url($url);
+#
+# DESCRIPTION
+#   Returns a tidied version of $url by removing . and .. in the path.
+# ------------------------------------------------------------------------------
+
+sub tidy_url {
+    my ($url) = @_;
+    if (!is_url($url)) {
+        return $url;
+    }
+    my $DOT_PATTERN     = qr{/+ \. (?:/+|(@|\z))}xms;
+    my $DOT_DOT_PATTERN = qr{/+ [^/]+ /+ \.\. (?:/+|(@|\z))}xms;
+    my $TRAILING_SLASH_PATTERN = qr{([^/]+) /* (@|\z)}xms;
+    my $RIGHT_EVAL = q{'/' . ($1 ? $1 : '')};
+    DOT:
+    while ($url =~ s{$DOT_PATTERN}{$RIGHT_EVAL}eegxms) {
+        next DOT;
+    }
+    DOT_DOT:
+    while ($url =~ s{$DOT_DOT_PATTERN}{$RIGHT_EVAL}eegxms) {
+        next DOT_DOT;
+    }
+    $url =~ s{$TRAILING_SLASH_PATTERN}{$1$2}xms;
+    return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_wct ([$dir]);
+#
+# DESCRIPTION
+#   If current working directory (or $dir) is a Subversion working copy,
+#   returns the top directory of this working copy; otherwise returns an empty
+#   string.
+# ------------------------------------------------------------------------------
+
+sub get_wct {
+  my $dir = @_ ? $_[0] : cwd ();
+
+  return '' if not &is_wc ($dir);
+
+  my $updir = dirname $dir;
+  while (&is_wc ($updir)) {
+    $dir   = $updir;
+    $updir = dirname $dir;
+    last if $updir eq $dir;
+  }
+
+  return $dir;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL of the associated Subversion repository; otherwise returns
+#   an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_url_peg_of_wc ([$path[, $refresh]]);
+#
+# DESCRIPTION
+#   If current working directory (or $path) is a Subversion working copy,
+#   returns the URL@REV of the associated Subversion repository; otherwise
+#   returns an empty string. If $refresh is specified, do not use the cached
+#   information.
+# ------------------------------------------------------------------------------
+
+sub get_url_peg_of_wc {
+  my $path    = @_ ? $_[0] : cwd ();
+  my $refresh = exists $_[1] ? $_[1] : 0;
+  my $url  = '';
+
+  if (&is_wc ($path)) {
+    delete $svn_info{$path} if $refresh;
+    &_invoke_svn_info (PATH => $path) unless exists $svn_info{$path};
+    $url = $svn_info{$path}{URL} . '@' . $svn_info{$path}{Revision};
+  }
+
+  return $url;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &_invoke_svn_info (PATH => $path);
+#
+# DESCRIPTION
+#   The function is internal to this module. It invokes "svn info" on $path to
+#   gather information on URL, Revision and Last Changed Rev. The information
+#   is stored in a hash table at the module level, so that the information can
+#   be re-used.
+# ------------------------------------------------------------------------------
+
+sub _invoke_svn_info {
+  my %args = @_;
+  my $path = $args{PATH};
+  my $cfg  = Fcm::Config->instance();
+
+  return if exists $svn_info{$path};
+
+  # Invoke "svn info" command
+  my @info = &run_command (
+    [qw/svn info/, $path],
+    PRINT => $cfg->verbose > 2, METHOD => 'qx', DEVNULL => 1, ERROR => 'ignore',
+  );
+  for (@info) {
+    chomp;
+
+    if (/^(URL|Revision|Last Changed Rev):\s*(.+)$/) {
+      $svn_info{$path}{$1} = $2;
+    }
+  }
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $string = &get_command_string ($cmd);
+#   $string = &get_command_string (\@cmd);
+#
+# DESCRIPTION
+#   The function returns a string by converting the list in @cmd or the scalar
+#   $cmd to a form, where it can be executed as a shell command.
+# ------------------------------------------------------------------------------
+
+sub get_command_string {
+  my $cmd    = $_[0];
+  my $return = '';
+
+  if (ref ($cmd) and ref ($cmd) eq 'ARRAY') {
+    # $cmd is a reference to an array
+
+    # Print each argument
+    for my $i (0 .. @{ $cmd } - 1) {
+      my $arg = $cmd->[$i];
+
+      $arg =~ s/./*/g if $i > 0 and $cmd->[$i - 1] eq '--password';
+
+      if ($arg =~ /[\s'"*?]/) {
+        # Argument contains a space, quote it
+        if (index ($arg, "'") >= 0) {
+          # Argument contains an apostrophe, quote it with double quotes
+          $return .= ($i > 0 ? ' ' : '') . '"' . $arg . '"';
+
+        } else {
+          # Otherwise, quote argument with apostrophes
+          $return .= ($i > 0 ? ' ' : '') . "'" . $arg . "'";
+        }
+
+      } else {
+        # Argument does not contain a space, just print it
+        $return .= ($i > 0 ? ' ' : '') . ($arg eq '' ? "''" : $arg);
+      }
+    }
+
+  } else {
+    # $cmd is a scalar, just print it "as is"
+    $return = $cmd;
+  }
+
+  return $return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &print_command ($cmd);
+#   &print_command (\@cmd);
+#
+# DESCRIPTION
+#   The function prints the list in @cmd or the scalar $cmd, as it would be
+#   executed by the shell.
+# ------------------------------------------------------------------------------
+
+sub print_command {
+  my $cmd = $_[0];
+
+  print '=> ', &get_command_string ($cmd) , "\n";
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   @return = &run_command (\@cmd, <OPTIONS>);
+#   @return = &run_command ($cmd , <OPTIONS>);
+#
+# DESCRIPTION
+#   This function executes the command in the list @cmd or in the scalar $cmd.
+#   The remaining are optional arguments in a hash table. Valid options are
+#   listed below. If the command is run using "qx", the function returns the
+#   standard output from the command. If the command is run using "system", the
+#   function returns true on success. By default, the function dies on failure.
+#
+# OPTIONS
+#   METHOD  => $method - this can be "system", "exec" or "qx". This determines
+#                        how the command will be executed. If not set, the
+#                        default is to run the command with "system".
+#   PRINT   => 1       - if set, print the command before executing it.
+#   ERROR   => $flag   - this should only be set if METHOD is set to "system"
+#                        or "qx". The $flag can be "die" (default), "warn" or
+#                        "ignore". If set to "die", the function dies on error.
+#                        If set to "warn", the function issues a warning on
+#                        error, and the function returns false. If set to
+#                        "ignore", the function returns false on error.
+#   RC      => 1       - if set, must be a reference to a scalar, which will be
+#                        set to the return code of the command.
+#   DEVNULL => 1       - if set, re-direct STDERR to /dev/null before running
+#                        the command.
+#   TIME    => 1       - if set, print the command with a timestamp before
+#                        executing it, and print the time taken when it
+#                        completes. This option supersedes the PRINT option.
+# ------------------------------------------------------------------------------
+
+sub run_command {
+  my ($cmd, %input_opt_of) = @_;
+  my %opt_of = (
+    DEVNULL => undef,
+    ERROR   => 'die',
+    METHOD  => 'system',
+    PRINT   => undef,
+    RC      => undef,
+    TIME    => undef,
+    %input_opt_of,
+  );
+  local($|) = 1; # Make sure STDOUT is flushed before running command
+
+  # Print the command before execution, if necessary
+  if ($opt_of{TIME}) {
+    print(timestamp_command(get_command_string($cmd)));
+  }
+  elsif ($opt_of{PRINT}) {
+    print_command($cmd);
+  }
+
+  # Re-direct STDERR to /dev/null if necessary
+  if ($opt_of{DEVNULL}) {
+    no warnings;
+    open(OLDERR, ">&STDERR") || croak("Cannot dup STDERR ($!), abort");
+    use warnings;
+    open(STDERR, '>', File::Spec->devnull())
+      || croak("Cannot redirect STDERR ($!), abort");
+    # Make sure the channels are unbuffered
+    my $select = select();
+    select(STDERR); local($|) = 1;
+    select($select);
+  }
+
+  my @return = ();
+  if (ref($cmd) && ref($cmd) eq 'ARRAY') {
+    # $cmd is an array
+    my @command = @{$cmd};
+    if ($opt_of{METHOD} eq 'qx') {
+      @return = qx(@command);
+    }
+    elsif ($opt_of{METHOD} eq 'exec') {
+      exec(@command);
+    }
+    else {
+      system(@command);
+      @return = $? ? () : (1);
+    }
+  }
+  else {
+    # $cmd is an scalar
+    if ($opt_of{METHOD} eq 'qx') {
+      @return = qx($cmd);
+    }
+    elsif ($opt_of{METHOD} eq 'exec') {
+      exec($cmd);
+    }
+    else {
+      system($cmd);
+      @return = $? ? () : (1);
+    }
+  }
+  my $rc = $?;
+
+  # Put STDERR back to normal, if redirected previously
+  if ($opt_of{DEVNULL}) {
+    close(STDERR);
+    open(STDERR, ">&OLDERR") || croak("Cannot dup STDERR ($!), abort");
+  }
+
+  # Print the time taken for command after execution, if necessary
+  if ($opt_of{TIME}) {
+    print(timestamp_command(get_command_string($cmd), 'end'));
+  }
+
+  # Signal and return code
+  my ($signal, $status) = (WTERMSIG($rc), WEXITSTATUS($rc));
+  if (exists($opt_of{RC})) {
+    ${$opt_of{RC}} = $status;
+  }
+  if (WIFSIGNALED($rc) && grep {$signal == $_} (SIGINT, SIGKILL, SIGTERM)) {
+    croak(sprintf('%s terminated (%d)', get_command_string($cmd), $signal));
+  }
+  if ($status && $opt_of{ERROR} ne 'ignore') {
+    my $func_ref = $opt_of{ERROR} eq 'warn' ? \&carp : \&croak;
+    $func_ref->(sprintf('%s failed (%d)', get_command_string($cmd), $status));
+  }
+  return @return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &e_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and aborts with a error.
+# ------------------------------------------------------------------------------
+
+sub e_report {
+  print STDERR @_, "\n" if @_;
+
+  exit 1;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   &w_report (@message);
+#
+# DESCRIPTION
+#   The function prints @message to STDERR and returns.
+# ------------------------------------------------------------------------------
+
+sub w_report {
+  print STDERR @_, "\n" if @_;
+
+  return;
+}
+
+# ------------------------------------------------------------------------------
+# SYNOPSIS
+#   $date = &svn_date ($time);
+#
+# DESCRIPTION
+#   The function returns a date, formatted as by Subversion. The argument $time
+#   is the number of seconds since epoch.
+# ------------------------------------------------------------------------------
+
+sub svn_date {
+  my $time = shift;
+
+  return strftime ('%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)', localtime ($time));
+}
+
+# ------------------------------------------------------------------------------
+
+1;
+
+__END__
Index: vendors/FCM/lib/Fcm/Util/ClassLoader.pm
===================================================================
--- vendors/FCM/lib/Fcm/Util/ClassLoader.pm	(revision 9621)
+++ vendors/FCM/lib/Fcm/Util/ClassLoader.pm	(revision 9621)
@@ -0,0 +1,80 @@
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+use strict;
+use warnings;
+
+package Fcm::Util::ClassLoader;
+use base qw{Exporter};
+
+our @EXPORT_OK = qw{load};
+
+use Carp qw{croak};
+use Fcm::Exception;
+
+sub load {
+    my ($class, $test_method) = @_;
+    if (!$test_method) {
+        $test_method = 'new';
+    }
+    if (!UNIVERSAL::can($class, $test_method)) {
+        eval('require ' . $class);
+        if ($@) {
+            croak(Fcm::Exception->new({message => sprintf(
+                "%s: class loading failed: %s", $class, $@,
+            )}));
+        }
+    }
+    return $class;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Fcm::ClassLoader
+
+=head1 SYNOPSIS
+
+    use Fcm::Util::ClassLoader;
+    $load_ok = Fcm::Util::ClassLoader::load($class);
+
+=head1 DESCRIPTION
+
+A wrapper for loading a class dynamically.
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item load($class,$test_method)
+
+If $class can call $test_method, returns $class. Otherwise, attempts to
+require() $class and returns it. If this fails, croak() with a
+L<Fcm::Exception|Fcm::Exception>.
+
+=item load($class)
+
+Shorthand for C<load($class, 'new')>.
+
+=back
+
+=head1 DIAGNOSTICS
+
+=over 4
+
+=item L<Fcm::Exception|Fcm::Exception>
+
+The load($class,$test_method) function croak() with this exception if it fails
+to load the specified class.
+
+=back
+
+=head1 COPYRIGHT
+
+E<169> Crown copyright Met Office. All rights reserved.
+
+=cut
Index: vendors/FCM/man/man1/fcm.1
===================================================================
--- vendors/FCM/man/man1/fcm.1	(revision 9621)
+++ vendors/FCM/man/man1/fcm.1	(revision 9621)
@@ -0,0 +1,35 @@
+.\" Process this file with
+.\" groff -man -Tascii fcm.1
+.\"
+.TH fcm 1 "" "" "User Commands"
+.SH NAME
+fcm - command line client for the Flexible Configuration Management system
+.SH SYNOPSIS
+.B fcm
+.I command
+[
+.I options
+] [
+.I args
+]
+.SH OVERVIEW
+.B fcm
+is the command line client for code management commands, the extract system and
+the build system of the Flexible Configuration Management (FCM) system.
+For full detail of the system, please refer to the FCM user guide, which you
+should receive with this distribution in both HTML and PDF formats.
+.PP
+Run "fcm help" to access the built-in tool documentation.
+.SH AUTHOR
+FCM Team <fcm-team@metoffice.gov.uk>.
+Please feedback any bug reports or feature requests to us by e-mail.
+.SH COPYRIGHT
+British Crown Copyright \(co Met Office. All rights reserved.
+.PP
+You can use this release of
+.B FCM
+freely under the terms of the FCM LICENSE,
+which you should receive with this distribution.
+.SH SEE ALSO
+.BR svn (1),
+.BR perl (1)
Index: vendors/FCM/t/Fcm/Build/Fortran-extract-interface-result.f90
===================================================================
--- vendors/FCM/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 9621)
+++ vendors/FCM/t/Fcm/Build/Fortran-extract-interface-result.f90	(revision 9621)
@@ -0,0 +1,70 @@
+interface
+logical function func_simple()
+end function func_simple
+logical function func_simple_1()
+end function
+logical function func_simple_2()
+end
+pure logical function func_simple_pure()
+end function func_simple_pure
+recursive pure integer function func_simple_recursive_pure(i)
+integer, intent(in) :: i
+end function func_simple_recursive_pure
+elemental logical function func_simple_elemental()
+end function func_simple_elemental
+integer(selected_int_kind(0)) function func_with_use_and_args(egg, ham)
+use foo
+use bar, only:&
+ & i_am_dim
+integer, intent(in) :: egg(i_am_dim)
+integer, intent(in) :: ham(i_am_dim, 2)
+end function func_with_use_and_args
+character(20) function func_with_parameters(egg, ham)
+character*(*), parameter :: x_param = '01234567890'
+character(*), parameter :: &
+ y_param &
+ = '!&!&!&!&!&!'
+character(len(x_param)), intent(in) :: egg
+character(len(y_param)), intent(in) :: ham
+end function func_with_parameters
+function func_with_parameters_1(egg, ham) result(r)
+integer, parameter :: x_param = 10
+integer z_param
+parameter(z_param = 2)
+real, intent(in), dimension(x_param) :: egg
+integer, intent(in) :: ham
+logical :: r(z_param)
+end function func_with_parameters_1
+character(10) function func_with_contains(mushroom, tomoato)
+character(5) mushroom
+character(5) tomoato
+end function func_with_contains
+Function func_mix_local_and_result(egg, ham, bacon) Result(Breakfast)
+Integer, Intent(in) :: egg, ham
+Real, Intent(in) :: bacon
+Real :: tomato, breakfast
+End Function func_mix_local_and_result
+subroutine sub_simple()
+end subroutine sub_simple
+subroutine sub_simple_1()
+end subroutine
+subroutine sub_simple_2()
+end
+subroutine sub_simple_3()
+end sub&
+&routine&
+& sub_simple_3
+subroutine sub_with_contains(foo)
+character*(len('!"&''&"!')) &
+ foo
+end subroutine sub_with_contains
+subroutine sub_with_renamed_import(i_am_dim)
+integer, parameter :: d = 2
+complex :: i_am_dim(d)
+end subroutine sub_with_renamed_import
+subroutine sub_with_external(proc)
+external proc
+end subroutine sub_with_external
+subroutine sub_with_end()
+end subroutine sub_with_end
+end interface
Index: vendors/FCM/t/Fcm/Build/Fortran-extract-interface-source.f90
===================================================================
--- vendors/FCM/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 9621)
+++ vendors/FCM/t/Fcm/Build/Fortran-extract-interface-source.f90	(revision 9621)
@@ -0,0 +1,181 @@
+! A simple function
+logical function func_simple()
+func_simple = .true.
+end function func_simple
+
+! A simple function, but with less friendly end
+logical function func_simple_1()
+func_simple_1 = .true.
+end function
+
+! A simple function, but with even less friendly end
+logical function func_simple_2()
+func_simple_2 = .true.
+end
+
+! A pure simple function
+pure logical function func_simple_pure()
+func_simple_pure = .true.
+end function func_simple_pure
+
+! A pure recursive function
+recursive pure integer function func_simple_recursive_pure(i)
+integer, intent(in) :: i
+if (i <= 0) then
+    func_simple_recursive_pure = i
+else
+    func_simple_recursive_pure = i + func_simple_recursive_pure(i - 1)
+end if
+end function func_simple_recursive_pure
+
+! An elemental simple function
+elemental logical function func_simple_elemental()
+func_simple_elemental = .true.
+end function func_simple_elemental
+
+! A module with nonsense
+module bar
+type food
+integer :: cooking_method
+end type food
+type organic
+integer :: growing_method
+end type organic
+integer, parameter :: i_am_dim = 10
+end module bar
+
+! A module with more nonsense
+module foo
+use bar, only: FOOD
+integer :: foo_int
+contains
+subroutine foo_sub(egg)
+integer, parameter :: egg_dim = 10
+type(Food), intent(in) :: egg
+write(*, *) egg
+end subroutine foo_sub
+elemental function foo_func() result(f)
+integer :: f
+f = 0
+end function
+end module foo
+
+! An function with arguments and module imports
+integer(selected_int_kind(0)) function func_with_use_and_args(egg, ham)
+use foo
+! Deliberate trailing spaces in next line
+use bar, only : organic,     i_am_dim   
+implicit none
+integer, intent(in) :: egg(i_am_dim)
+integer, intent(in) :: ham(i_am_dim, 2)
+real bacon
+! Deliberate trailing spaces in next line
+type(   organic   ) :: tomato   
+func_with_use_and_args = egg(1) + ham(1, 1)
+end function func_with_use_and_args
+
+! A function with some parameters
+character(20) function func_with_parameters(egg, ham)
+implicit none
+character*(*), parameter :: x_param = '01234567890'
+character(*), parameter :: & ! throw in some comments
+    y_param                &
+    = '!&!&!&!&!&!'          ! how to make life interesting
+integer, parameter :: z = 20
+character(len(x_param)), intent(in) :: egg
+character(len(y_param)), intent(in) :: ham
+func_with_parameters = egg // ham
+end function func_with_parameters
+
+! A function with some parameters, with a result
+function func_with_parameters_1(egg, ham) result(r)
+implicit none
+integer, parameter :: x_param = 10
+integer z_param
+parameter(z_param = 2)
+real, intent(in), dimension(x_param) :: egg
+integer, intent(in) :: ham
+logical :: r(z_param)
+r(1) = int(egg(1)) + ham > 0
+r(2) = .false.
+end function func_with_parameters_1
+
+! A function with a contains
+character(10) function func_with_contains(mushroom, tomoato)
+character(5) mushroom
+character(5) tomoato
+func_with_contains = func_with_contains_1()
+contains
+character(10) function func_with_contains_1()
+func_with_contains_1 = mushroom // tomoato
+end function func_with_contains_1
+end function func_with_contains
+
+! A function with its result declared after a local in the same statement
+Function func_mix_local_and_result(egg, ham, bacon) Result(Breakfast)
+Integer, Intent(in) :: egg, ham
+Real, Intent(in) :: bacon
+Real :: tomato, breakfast
+Breakfast = real(egg) + real(ham) + bacon
+End Function func_mix_local_and_result
+
+! A simple subroutine
+subroutine sub_simple()
+end subroutine sub_simple
+
+! A simple subroutine, with not so friendly end
+subroutine sub_simple_1()
+end subroutine
+
+! A simple subroutine, with even less friendly end
+subroutine sub_simple_2()
+end
+
+! A simple subroutine, with funny continuation
+subroutine sub_simple_3()
+end sub&
+&routine&
+& sub_simple_3
+
+! A subroutine with a few contains
+subroutine sub_with_contains(foo) ! " &
+! Deliberate trailing spaces in next line
+use Bar, only: i_am_dim    
+character*(len('!"&''&"!')) & ! what a mess!
+    foo
+call sub_with_contains_first()
+call sub_with_contains_second()
+call sub_with_contains_third()
+print*, foo
+contains
+subroutine sub_with_contains_first()
+interface
+integer function x()
+end function x
+end interface
+end subroutine sub_with_contains_first
+subroutine sub_with_contains_second()
+end subroutine
+subroutine sub_with_contains_third()
+end subroutine
+end subroutine sub_with_contains
+
+! A subroutine with a renamed module import
+subroutine sub_with_renamed_import(i_am_dim)
+use bar, only: i_am_not_dim => i_am_dim
+integer, parameter :: d = 2
+complex :: i_am_dim(d)
+print*, i_am_dim
+end subroutine sub_with_renamed_import
+
+! A subroutine with an external argument
+subroutine sub_with_external(proc)
+external proc
+call proc()
+end subroutine sub_with_external
+
+! A subroutine with a variable named "end"
+subroutine sub_with_end()
+integer :: end
+end = 0
+end subroutine sub_with_end
Index: vendors/FCM/t/Fcm/Build/Fortran.t
===================================================================
--- vendors/FCM/t/Fcm/Build/Fortran.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Build/Fortran.t	(revision 9621)
@@ -0,0 +1,43 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../../../lib";
+
+use Test::More (tests => 3);
+
+if (!caller()) {
+    main(@ARGV);
+}
+
+sub main {
+    my $CLASS = 'Fcm::Build::Fortran';
+    use_ok($CLASS);
+    my $util = $CLASS->new();
+    isa_ok($util, $CLASS);
+    test_extract_interface($util);
+}
+
+sub test_extract_interface {
+    my ($util) = @_;
+    my $root = ($0 =~ qr{\A(.+)\.t\z}msx)[0];
+    my $f90 = $root . '-extract-interface-source.f90';
+    my $f90_interface = $root . '-extract-interface-result.f90';
+    open(my($handle_for_source), '<', $f90) || die("$f90: $!");
+    my @actual_lines = $util->extract_interface($handle_for_source);
+    close($handle_for_source);
+    open(my($handle_for_result), '<', $f90_interface)
+        || die("$f90_interface: $!");
+    my @expected_lines = readline($handle_for_result);
+    close($handle_for_result);
+    is_deeply(\@actual_lines, \@expected_lines, 'extract_interface');
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI.t
===================================================================
--- vendors/FCM/t/Fcm/CLI.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI.t	(revision 9621)
@@ -0,0 +1,237 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+
+################################################################################
+# A sub-class of Fcm::CLI::Invoker for testing
+{
+    package TestInvoker;
+    use base qw{Fcm::CLI::Invoker};
+
+    our $LATEST_INSTANCE;
+
+    ############################################################################
+    # Returns a test attrib
+    sub get_test_attrib {
+        my ($self) = @_;
+        return $self->{test_attrib};
+    }
+
+    ############################################################################
+    # Invokes the sub-system
+    sub invoke {
+        my ($self) = @_;
+        $LATEST_INSTANCE = $self;
+    }
+}
+
+use Fcm::CLI::Config;
+use Fcm::CLI::Subcommand;
+use Test::More (tests => 25);
+
+main();
+
+sub main {
+    use_ok('Fcm::CLI');
+    test_invalid_subcommand();
+    test_invoker_not_implemented();
+    test_normal_invoke();
+    test_help_invoke();
+    test_get_invoker_normal();
+    test_load_invoker_class();
+}
+
+################################################################################
+# Tests to ensure that an invalid subcommand results in an exception
+sub test_invalid_subcommand {
+    Fcm::CLI::Config->instance({core_subcommands => [], vc_subcommands => []});
+    eval {
+        local(@ARGV) = ('foo');
+        Fcm::CLI::invoke();
+    };
+    like($@, qr{foo: unknown command}, 'invalid subcommand');
+}
+
+################################################################################
+# Tests to ensure that an unimplemented invoker results in an exception
+sub test_invoker_not_implemented {
+    Fcm::CLI::Config->instance({
+        core_subcommands => [
+            Fcm::CLI::Subcommand->new({names => ['foo']}),
+            Fcm::CLI::Subcommand->new({
+                names => ['bar'], invoker_class => 'barley',
+            }),
+        ],
+        vc_subcommands   => [],
+    });
+    eval {
+        local(@ARGV) = ('foo');
+        Fcm::CLI::invoke();
+    };
+    like($@, qr{foo: \s command \s not \s implemented}xms, 'not implemented');
+    eval {
+        local(@ARGV) = ('bar');
+        Fcm::CLI::invoke();
+    };
+    like($@, qr{barley: \s class \s loading \s failed}xms, 'not implemented');
+}
+
+################################################################################
+# Tests normal usage of invoke
+sub test_normal_invoke {
+    my $prefix = "normal invoke";
+    Fcm::CLI::Config->instance({
+        core_subcommands => [
+            Fcm::CLI::Subcommand->new({
+                names          => ['foo'],
+                invoker_class  => 'TestInvoker',
+                invoker_config => {test_attrib => 'test_attrib value'},
+            }),
+        ],
+        vc_subcommands   => [],
+    });
+    ok(!$TestInvoker::LATEST_INSTANCE, "$prefix: invoker not called");
+    local(@ARGV) = ('foo', 'bar', 'baz');
+    Fcm::CLI::invoke();
+    my $invoker = $TestInvoker::LATEST_INSTANCE;
+    if (!$invoker) {
+        fail($prefix);
+    }
+    else {
+        is($invoker->get_command(), 'foo', "$prefix: invoker command");
+        is_deeply({$invoker->get_options()}, {}, "$prefix: invoker options");
+        is_deeply([$invoker->get_arguments()], ['bar', 'baz'],
+            "$prefix: invoker arguments");
+        is($invoker->get_test_attrib(), 'test_attrib value',
+            "$prefix: invoker test attrib");
+    }
+    $TestInvoker::LATEST_INSTANCE = undef;
+}
+
+################################################################################
+# Tests help usage of invoke
+sub test_help_invoke {
+    my $prefix = "help invoke";
+    Fcm::CLI::Config->instance({
+        core_subcommands => [
+            Fcm::CLI::Subcommand->new({
+                names          => ['foo'],
+                invoker_class  => 'TestInvoker',
+                invoker_config => {test_attrib => 'test_attrib value normal'},
+                options        => [
+                    Fcm::CLI::Option->new({name => 'foo', is_help => 1}),
+                ],
+            }),
+            Fcm::CLI::Subcommand->new({
+                names          => [q{}],
+                invoker_class  => 'TestInvoker',
+            }),
+        ],
+        vc_subcommands   => [],
+    });
+    ok(!$TestInvoker::LATEST_INSTANCE, "$prefix: invoker not called");
+    local(@ARGV) = ('foo', '--foo');
+    Fcm::CLI::invoke();
+    my $invoker = $TestInvoker::LATEST_INSTANCE;
+    if (!$invoker) {
+        fail($prefix);
+    }
+    else {
+        is_deeply([$invoker->get_arguments()], ['foo'],
+            "$prefix: invoker argument");
+    }
+    $TestInvoker::LATEST_INSTANCE = undef;
+}
+
+################################################################################
+# Tests getting an invoker
+sub test_get_invoker_normal {
+    my $prefix = 'get invoker normal';
+    my @options = (
+        Fcm::CLI::Option->new({name => 'foo'}),
+        Fcm::CLI::Option->new({name => 'bar'}),
+        Fcm::CLI::Option->new({name => 'baz'}),
+        Fcm::CLI::Option->new({
+            name      => q{pork},
+            delimiter => q{,},
+            has_arg   => Fcm::CLI::Option->ARRAY_ARG,
+        }),
+    );
+    my $subcommand = Fcm::CLI::Subcommand->new({options => \@options});
+    my %TEST = (
+        test1 => {
+            argv      => ['--foo', '--bar', 'egg', 'ham', 'sausage'],
+            command   => 'command',
+            options   => {foo => 1, bar => 1},
+            arguments => ['egg', 'ham', 'sausage'],
+        },
+        test2 => {
+            argv      => ['--baz', '--foo', '--bar'],
+            command   => 'test',
+            options   => {foo => 1, bar => 1, baz => 1},
+            arguments => [],
+        },
+        test3 => {
+            argv      => ['egg', 'ham', 'sausage'],
+            command   => 'meal',
+            options   => {},
+            arguments => ['egg', 'ham', 'sausage'],
+        },
+        test4 => {
+            argv      => ['--pork', 'ham', '--pork', 'sausage'],
+            command   => 'pig',
+            options   => {pork => ['ham', 'sausage']},
+            arguments => [],
+        },
+        test5 => {
+            argv      => ['--pork', 'ham,sausage', '--pork', 'bacon', 'liver'],
+            command   => 'pig',
+            options   => {pork => ['ham', 'sausage', 'bacon']},
+            arguments => ['liver'],
+        },
+    );
+    for my $key (keys(%TEST)) {
+        local(@ARGV) = @{$TEST{$key}{argv}};
+        my ($opts_ref, $args_ref) = Fcm::CLI::_parse_argv_using($subcommand);
+        is_deeply($opts_ref, $TEST{$key}{options},
+            "$prefix $key: get options");
+        is_deeply($args_ref, $TEST{$key}{arguments},
+            "$prefix $key: get arguments");
+    }
+    my %BAD_TEST = (
+        test1 => {
+            argv => ['--egg', '--bar', 'foo', 'ham', 'sausage'],
+        },
+        test2 => {
+            argv => ['--foo=egg'],
+        },
+    );
+    for my $key (keys(%BAD_TEST)) {
+        local(@ARGV) = @{$BAD_TEST{$key}{argv}};
+        eval {
+            Fcm::CLI::_parse_argv_using($subcommand);
+        };
+        isa_ok($@, 'Fcm::CLI::Exception', "$prefix $key");
+    }
+}
+
+################################################################################
+# Tests loading an invoker with a different class
+sub test_load_invoker_class {
+    my $prefix = 'get invoker class';
+    eval {
+        my $subcommand = Fcm::CLI::Subcommand->new({invoker_class => 'foo'});
+        Fcm::CLI::_load_invoker_class_of($subcommand);
+    };
+    isa_ok($@, 'Fcm::Exception', "$prefix");
+
+    my $invoker_class = 'Fcm::CLI::Invoker::ConfigSystem';
+    my $subcommand
+        = Fcm::CLI::Subcommand->new({invoker_class => $invoker_class});
+    my $class = Fcm::CLI::_load_invoker_class_of($subcommand);
+    is($class, $invoker_class, "$prefix: $invoker_class");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Config.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Config.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Config.t	(revision 9621)
@@ -0,0 +1,86 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::CLI::Config::Default;
+use Fcm::CLI::Subcommand;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Config';
+    use_ok($class);
+    test_get_instance($class);
+    test_get_subcommand_of_string($class);
+}
+
+################################################################################
+# Tests normal usage of getting an instance
+sub test_get_instance {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $cli_config = $class->instance();
+    isa_ok($cli_config, $class, "$prefix");
+    is_deeply(
+        [$cli_config->get_core_subcommands()],
+        \@Fcm::CLI::Config::Default::CORE_SUBCOMMANDS,
+        "$prefix: default core",
+    );
+    is_deeply(
+        [$cli_config->get_vc_subcommands()],
+        \@Fcm::CLI::Config::Default::VC_SUBCOMMANDS,
+        "$prefix: default vc",
+    );
+    is_deeply(
+        [$cli_config->get_subcommands()],
+        [$cli_config->get_core_subcommands(), $cli_config->get_vc_subcommands()],
+        "$prefix: default",
+    );
+    is($class->instance(), $cli_config, "$prefix: same instance");
+    isnt($class->instance({}), $cli_config, "$prefix: not the same instance");
+    my $empty_cli_config = $class->instance({
+        core_subcommands => [],
+        vc_subcommands   => [],
+    });
+    is_deeply(
+        [$empty_cli_config->get_core_subcommands()],
+        [],
+        "$prefix: empty core",
+    );
+    is_deeply(
+        [$empty_cli_config->get_vc_subcommands()],
+        [],
+        "$prefix: empty vc",
+    );
+    is_deeply(
+        [$empty_cli_config->get_subcommands()],
+        [],
+        "$prefix: empty",
+    );
+}
+
+################################################################################
+# Tests getting a subcommand of a matching string
+sub test_get_subcommand_of_string {
+    my ($class) = @_;
+    my $prefix = 'get_subcommand_of';
+    my $foo_subcommand = Fcm::CLI::Subcommand->new({names => ['food', 'foo']});
+    my $bar_subcommand = Fcm::CLI::Subcommand->new({names => ['barley', 'bar']});
+    my $cli_config = $class->instance({
+        core_subcommands => [$foo_subcommand, $bar_subcommand],
+        vc_subcommands   => [],
+    });
+    for my $key ('food', 'foo') {
+        is($cli_config->get_subcommand_of($key), $foo_subcommand,
+            "$prefix: $key");
+    }
+    for my $key ('barley', 'bar') {
+        is($cli_config->get_subcommand_of($key), $bar_subcommand,
+            "$prefix: $key");
+    }
+    is($cli_config->get_subcommand_of('baz'), undef, "$prefix: baz");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Config/Default.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Config/Default.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Config/Default.t	(revision 9621)
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Config::Default';
+    use_ok($class);
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Exception.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Exception.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Exception.t	(revision 9621)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Exception';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $e = $class->new({message => 'message'});
+    isa_ok($e, $class, $prefix);
+    is("$e", "$class: message\n", "$prefix: as_string()");
+    is($e->get_message(), 'message', "$prefix: get_message()");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker.t	(revision 9621)
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = "normal";
+    my %OPTIONS   = (option1 => 1, option2 => 2, option3 => 3);
+    my @ARGUMENTS = ('argument 1', 'argument 2');
+    my $invoker = $class->new({
+        command   => 'command',
+        options   => \%OPTIONS,
+        arguments => \@ARGUMENTS,
+    });
+    isa_ok($invoker, $class, $prefix);
+    is($invoker->get_command(), 'command', "$prefix: command");
+    is_deeply({$invoker->get_options()}, \%OPTIONS, "$prefix: options");
+    is_deeply([$invoker->get_arguments()], \@ARGUMENTS, "$prefix: arguments");
+    eval {
+        $invoker->invoke();
+    };
+    isa_ok($@, 'Fcm::CLI::Exception', "$prefix: invoke");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/Browser.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/Browser.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/Browser.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::Browser';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/CM.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/CM.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/CM.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::CM';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/CfgPrinter.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/CfgPrinter.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::CfgPrinter';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/ConfigSystem.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/ConfigSystem.t	(revision 9621)
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A mock Fcm::ConfigSystem object
+{
+    package MockConfigSystem;
+    use base qw{Fcm::ConfigSystem};
+
+    our $LATEST_INVOKED_INSTANCE;
+
+    ############################################################################
+    # Returns the arguments to the last invoke() call
+    sub get_invoke_args {
+        my ($self) = @_;
+        return $self->{invoke_args};
+    }
+
+    ############################################################################
+    # Does nothing but captures the arguments
+    sub invoke {
+        my ($self, %args) = @_;
+        $LATEST_INVOKED_INSTANCE = $self;
+        $self->{invoke_args} = \%args;
+        return 1;
+    }
+}
+
+use Cwd;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::ConfigSystem';
+    use_ok($class);
+    test_invoke($class);
+}
+
+################################################################################
+# Tests normal usage of invoke()
+sub test_invoke {
+    my ($class) = @_;
+    my $prefix = "invoke";
+    my %TEST = (
+        test1 => {
+            command            => 'pig',
+            options            => {'egg' => 1},
+            arguments          => ['bacon'],
+            expected_options   => {FOO => undef, BAR_BAZ => undef, EGGS => 1},
+            expected_arguments => 'bacon',
+        },
+        test2 => {
+            command            => 'pig',
+            options            => {'foo' => 1, 'bar-baz' => 1},
+            arguments          => [],
+            expected_options   => {FOO => 1, BAR_BAZ => 1, EGGS => undef},
+            expected_arguments => cwd(),
+        }
+    );
+    for my $key (keys(%TEST)) {
+        my $invoker = $class->new({
+            command            => $TEST{$key}{command},
+            options            => $TEST{$key}{options},
+            arguments          => $TEST{$key}{arguments},
+            impl_class         => 'MockConfigSystem',
+            cli2invoke_key_map => {
+                'foo' => 'FOO', 'bar-baz' => 'BAR_BAZ', 'egg' => 'EGGS',
+            },
+        });
+        isa_ok($invoker, 'Fcm::CLI::Invoker::ConfigSystem', "$prefix: $key");
+        $invoker->invoke();
+        my $config_system_instance = $MockConfigSystem::LATEST_INVOKED_INSTANCE;
+        isa_ok(
+            $config_system_instance,
+            'Fcm::ConfigSystem',
+            "$prefix: $key: Fcm::ConfigSystem",
+        );
+        is(
+            $config_system_instance->cfg()->src(),
+            $TEST{$key}{expected_arguments},
+            "$prefix: $key: cfg()->src()",
+        );
+        is_deeply(
+            $config_system_instance->get_invoke_args(),
+            $TEST{$key}{expected_options},
+            "$prefix: $key: invoke args",
+        );
+    }
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/ExtractConfigComparator.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/ExtractConfigComparator.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::ExtractConfigComparator';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/GUI.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/GUI.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/GUI.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::GUI';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/Help.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/Help.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/Help.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::Help';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Invoker/KeywordPrinter.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Invoker/KeywordPrinter.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Invoker::KeywordPrinter';
+    use_ok($class);
+}
+
+# TODO: actual unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Option.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Option.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Option.t	(revision 9621)
@@ -0,0 +1,168 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Option';
+    use_ok($class);
+    test_simplest($class);
+    test_simplest_scalar_arg($class);
+    test_simplest_array_arg($class);
+    test_simplest_hash_arg($class);
+    test_simple($class);
+    test_simple_scalar_arg($class);
+    test_simple_array_arg($class);
+    test_simple_hash_arg($class);
+    test_long_letter($class);
+}
+
+################################################################################
+# Tests simplest usage
+sub test_simplest {
+    my ($class) = @_;
+    my $prefix = 'simplest';
+    my $option = $class->new({
+        delimiter   => 'delimiter-value',
+        description => 'description value',
+        name        => 'name-value',
+    });
+    isa_ok($option, $class);
+    is($option->get_delimiter(), 'delimiter-value', "$prefix: delimiter");
+    is($option->get_description(), 'description value', "$prefix: description");
+    is($option->get_name(), 'name-value', "$prefix: name");
+    is($option->get_letter(), undef, "$prefix: letter");
+    ok(!$option->has_arg(), "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with a scalar argument
+sub test_simplest_scalar_arg {
+    my ($class) = @_;
+    my $prefix = 'simplest scalar arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        has_arg     => $class->SCALAR_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->SCALAR_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value=s', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with array argument
+sub test_simplest_array_arg {
+    my ($class) = @_;
+    my $prefix = 'simplest array arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        has_arg     => $class->ARRAY_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->ARRAY_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value=s@', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with hash argument
+sub test_simplest_hash_arg {
+    my ($class) = @_;
+    my $prefix = 'simplest hash arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        has_arg     => $class->HASH_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->HASH_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value=s%', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simple usage
+sub test_simple {
+    my ($class) = @_;
+    my $prefix = 'simple';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+    });
+    isa_ok($option, $class);
+    is($option->get_description(), 'description value', "$prefix: description");
+    is($option->get_name(), 'name-value', "$prefix: name");
+    is($option->get_letter(), 'n', "$prefix: letter");
+    is($option->has_arg(), $class->NO_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simple usage with a scalar argument
+sub test_simple_scalar_arg {
+    my ($class) = @_;
+    my $prefix = 'simple scalar arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+        has_arg     => $class->SCALAR_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->SCALAR_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n=s', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with array argument
+sub test_simple_array_arg {
+    my ($class) = @_;
+    my $prefix = 'simple array arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+        has_arg     => $class->ARRAY_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->ARRAY_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n=s@', "$prefix: has arg");
+}
+
+################################################################################
+# Tests simplest usage with hash argument
+sub test_simple_hash_arg {
+    my ($class) = @_;
+    my $prefix = 'simple hash arg';
+    my $option = $class->new({
+        description => 'description value',
+        name        => 'name-value',
+        letter      => 'n',
+        has_arg     => $class->HASH_ARG,
+    });
+    isa_ok($option, $class);
+    is($option->has_arg(), $class->HASH_ARG, "$prefix: has arg");
+    is($option->get_arg_for_getopt_long(), 'name-value|n=s%', "$prefix: has arg");
+}
+
+################################################################################
+# Tests longer than 1 letter
+sub test_long_letter {
+    my ($class) = @_;
+    my $prefix = 'long letter';
+    my $option = $class->new({
+        name   => 'name-value',
+        letter => 'name',
+    });
+    isa_ok($option, $class);
+    is($option->get_letter(), 'n', "$prefix: letter");
+    is($option->get_arg_for_getopt_long(), 'name-value|n', "$prefix: has arg");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/CLI/Subcommand.t
===================================================================
--- vendors/FCM/t/Fcm/CLI/Subcommand.t	(revision 9621)
+++ vendors/FCM/t/Fcm/CLI/Subcommand.t	(revision 9621)
@@ -0,0 +1,74 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::CLI::Option;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::CLI::Subcommand';
+    use_ok($class);
+    test_constructor($class);
+    test_has_a_name($class);
+    test_as_string($class);
+}
+
+################################################################################
+# Tests the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my %OPTION_OF = (
+        description    => 'description value',
+        invoker_class  => 'invoker_class value',
+        invoker_config => 'invoker_config value',
+        is_vc          => 'is_vc value',
+        names          => 'names value',
+        options        => 'options value',
+        synopsis       => 'synopsis value',
+        usage          => 'usage value',
+    );
+    my $subcommand = Fcm::CLI::Subcommand->new(\%OPTION_OF);
+    isa_ok($subcommand, $class, $prefix);
+    for my $key (keys(%OPTION_OF)) {
+        my $getter = index($key, 'is') == 0 ? $key : "get_$key";
+        is($subcommand->$getter(), $OPTION_OF{$key}, "$prefix: $getter");
+    }
+}
+
+################################################################################
+# Tests match a string name to a subcommand
+sub test_has_a_name {
+    my ($class) = @_;
+    my $prefix = 'has a name';
+    my @NAMES = ('foo', 'bar', 'baz');
+    my $subcommand = $class->new({names => \@NAMES});
+    for my $name (@NAMES) {
+        ok($subcommand->has_a_name($name), "$prefix: $name");
+    }
+    for my $name (qw{egg ham mayo}) {
+        ok(!$subcommand->has_a_name($name), "$prefix: $name");
+    }
+}
+
+################################################################################
+# Tests string representation of a subcommand
+sub test_as_string {
+    my ($class) = @_;
+    my $prefix = 'as string';
+    my %OPTION_OF = (
+        'foo (bar, baz)' => ['foo', 'bar', 'baz'],
+        'foo (bar)'      => ['foo', 'bar'],
+        'foo'            => ['foo'],
+        q{}              => [],
+    );
+    for my $key (keys(%OPTION_OF)) {
+        my $subcommand = $class->new({names => $OPTION_OF{$key}});
+        is($subcommand->as_string(), $key, "$prefix: $key");
+    }
+}
+
+__END__
Index: vendors/FCM/t/Fcm/ConfigSystem.t
===================================================================
--- vendors/FCM/t/Fcm/ConfigSystem.t	(revision 9621)
+++ vendors/FCM/t/Fcm/ConfigSystem.t	(revision 9621)
@@ -0,0 +1,170 @@
+#!/usr/bin/perl
+# ------------------------------------------------------------------------------
+# (C) Crown copyright Met Office. All rights reserved.
+# For further details please refer to the file COPYRIGHT.txt
+# which you should have received as part of this distribution.
+# ------------------------------------------------------------------------------
+
+use strict;
+use warnings;
+
+use Fcm::CfgLine;
+use Fcm::Config;
+use Scalar::Util qw{reftype};
+use Test::More (tests => 90);
+
+BEGIN: {
+    use_ok('Fcm::ConfigSystem');
+}
+
+my $CONFIG = undef;
+
+# ------------------------------------------------------------------------------
+if (!caller()) {
+    main(@ARGV);
+}
+
+# ------------------------------------------------------------------------------
+sub main {
+    local @ARGV = @_;
+    test_compare_setting_in_config();
+}
+
+# ------------------------------------------------------------------------------
+# Tests "compare_setting_in_config".
+sub test_compare_setting_in_config {
+    my $PREFIX = 'TEST';
+    my %S = (egg => [qw{boiled poached}], ham => 'roasted', bacon => 'fried');
+    my %S_MOD = (ham => 'boiled');
+    my %S_MOD_ARRAY = (egg => [qw{scrambled omelette}]);
+    my %S_ADD = (mushroom => 'sauteed');
+    my %S_DEL = (bacon => undef);
+
+    my @ITEMS = (
+        {
+            name     => 'empty',
+            original => {},
+            added    => {},
+            removed  => {},
+            modified => {},
+        },
+        {
+            name     => 'add keys to empty',
+            original => {},
+            added    => {%S},
+            removed  => {},
+            modified => {%S},
+        },
+        {
+            name     => 'remove all',
+            original => {%S},
+            added    => {},
+            removed  => {},
+            modified => {map {($_, undef)} keys(%S)},
+        },
+        {
+            name     => 'no change',
+            original => {%S},
+            added    => {%S},
+            removed  => {},
+            modified => {},
+        },
+        {
+            name     => 'modify key',
+            original => {%S},
+            added    => {%S, %S_MOD},
+            removed  => {},
+            modified => {%S_MOD},
+        },
+        {
+            name     => 'modify an array key',
+            original => {%S},
+            added    => {%S, %S_MOD_ARRAY},
+            removed  => {},
+            modified => {%S_MOD_ARRAY},
+        },
+        {
+            name     => 'add a key',
+            original => {%S},
+            added    => {%S, %S_ADD},
+            removed  => {},
+            modified => {%S_ADD},
+        },
+        {
+            name     => 'delete a key',
+            original => {%S},
+            added    => {%S},
+            removed  => {%S_DEL},
+            modified => {%S_DEL},
+        },
+        {
+            name     => 'modify a key and delete a key',
+            original => {%S},
+            added    => {%S, %S_MOD},
+            removed  => {%S_DEL},
+            modified => {%S_MOD, %S_DEL},
+        },
+        {
+            name     => 'add a key and delete a key',
+            original => {%S},
+            added    => {%S, %S_ADD},
+            removed  => {%S_DEL},
+            modified => {%S_ADD, %S_DEL},
+        },
+    );
+
+    # A naive function to serialise an array reference
+    my $flatten = sub {
+        if (ref($_[0]) && reftype($_[0]) eq 'ARRAY') {
+            join(q{ }, sort(@{$_[0]}))
+        }
+        else {
+            $_[0];
+        }
+    };
+
+    my $CONFIG = Fcm::Config->instance();
+    for my $item (@ITEMS) {
+        # New settings
+        $CONFIG->{setting}{$PREFIX} = {%{$item->{added}}};
+        for my $key (keys(%{$item->{removed}})) {
+            delete($CONFIG->{setting}{$PREFIX}{$key});
+        }
+
+        # Old lines
+        my @old_lines = map {
+            Fcm::CfgLine->new(
+                LABEL => $PREFIX . $Fcm::Config::DELIMITER . $_,
+                VALUE => $flatten->($item->{original}{$_}),
+            )
+        } keys(%{$item->{original}});
+
+        # Invokes the method
+        my $system = Fcm::ConfigSystem->new();
+        my ($changed_hash_ref, $new_cfg_lines_ref)
+            = $system->compare_setting_in_config($PREFIX, \@old_lines);
+
+        # Tests the return values
+        my $T = $item->{name};
+        is_deeply(
+            $changed_hash_ref, $item->{modified},
+            "$T: \$changed_hash_ref content",
+        );
+        is(
+            scalar(@{$new_cfg_lines_ref}),
+            scalar(keys(%{$item->{added}})) - scalar(keys(%{$item->{removed}})),
+            "$T: \$new_cfg_lines_ref length",
+        );
+        for my $line (@{$new_cfg_lines_ref}) {
+            my $key = $line->label_from_field(1);
+            ok(exists($item->{added}{$key}), "$T: expected label $key");
+            ok(!exists($item->{removed}{$key}), "$T: unexpected label $key");
+            is(
+                $line->value(), $flatten->($item->{added}{$key}),
+                "$T: line content $key",
+            );
+        }
+    }
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Exception.t
===================================================================
--- vendors/FCM/t/Fcm/Exception.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Exception.t	(revision 9621)
@@ -0,0 +1,38 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Exception';
+    use_ok($class);
+    test_constructor_empty($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests empty constructor
+sub test_constructor_empty {
+    my ($class) = @_;
+    my $prefix = 'empty constructor';
+    my $e = $class->new();
+    isa_ok($e, $class, $prefix);
+    isnt("$e", undef, "$prefix: as_string() not undef");
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $e = $class->new({message => 'message'});
+    isa_ok($e, $class, $prefix);
+    is("$e", "$class: message\n", "$prefix: as_string()");
+    is($e->get_message(), 'message', "$prefix: get_message()");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/ExtractConfigComparator.t
===================================================================
--- vendors/FCM/t/Fcm/ExtractConfigComparator.t	(revision 9621)
+++ vendors/FCM/t/Fcm/ExtractConfigComparator.t	(revision 9621)
@@ -0,0 +1,17 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::ExtractConfigComparator';
+    use_ok($class);
+}
+
+# TODO: more real tests
+
+__END__
Index: vendors/FCM/t/Fcm/Interactive.t
===================================================================
--- vendors/FCM/t/Fcm/Interactive.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Interactive.t	(revision 9621)
@@ -0,0 +1,94 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A sub-class of Fcm::Interactive::InputGetter for testing
+{
+    package TestInputGetter;
+    use base qw{Fcm::Interactive::InputGetter};
+
+    ############################################################################
+    # A callback for testing
+    sub get_callback {
+        my ($self) = @_;
+        return $self->{callback};
+    }
+
+    ############################################################################
+    # Returns some pre-defined strings
+    sub invoke {
+        my ($self) = @_;
+        $self->get_callback()->(
+            $self->get_title(),
+            $self->get_message(),
+            $self->get_type(),
+            $self->get_default(),
+        );
+        return 'answer';
+    }
+}
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    use_ok('Fcm::Interactive');
+    test_default_impl();
+    test_set_impl();
+    test_get_input();
+}
+
+################################################################################
+# Tests default setting of input getter implementation
+sub test_default_impl {
+    my $prefix = 'default impl';
+    my ($class_name, $class_options_ref) = Fcm::Interactive::get_default_impl();
+    is($class_name, 'Fcm::Interactive::InputGetter::CLI', "$prefix: class name");
+    is_deeply($class_options_ref, {}, "$prefix: class options");
+}
+
+################################################################################
+# Tests setting the input getter implementation
+sub test_set_impl {
+    my $prefix = 'set impl';
+    my %options = (extra => 'extra-value');
+    my $name = 'TestInputGetter';
+    Fcm::Interactive::set_impl($name, \%options);
+    my ($class_name, $class_options_ref) = Fcm::Interactive::get_impl();
+    is($class_name, $name, "$prefix: class name");
+    is_deeply($class_options_ref, \%options, "$prefix: class options");
+}
+
+################################################################################
+# Tests getting input with test input getter
+sub test_get_input {
+    my $prefix = 'get input';
+    my %EXPECTED = (
+        TITLE   => 'title-value',
+        MESSAGE => 'message-value',
+        TYPE    => 'type-value',
+        DEFAULT => 'default-value',
+        ANSWER  => 'answer',
+    );
+    Fcm::Interactive::set_impl('TestInputGetter', {
+        callback => sub {
+            my ($title, $message, $type, $default) = @_;
+            is($title, $EXPECTED{TITLE}, "$prefix: title");
+            is($message, $EXPECTED{MESSAGE}, "$prefix: message");
+            is($type, $EXPECTED{TYPE}, "$prefix: type");
+            is($default, $EXPECTED{DEFAULT}, "$prefix: default");
+        },
+    });
+    my $ans = Fcm::Interactive::get_input(
+        title   => $EXPECTED{TITLE},
+        message => $EXPECTED{MESSAGE},
+        type    => $EXPECTED{TYPE},
+        default => $EXPECTED{DEFAULT},
+    );
+    is($ans, $EXPECTED{ANSWER}, "$prefix: answer");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Interactive/InputGetter.t
===================================================================
--- vendors/FCM/t/Fcm/Interactive/InputGetter.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Interactive/InputGetter.t	(revision 9621)
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Interactive::InputGetter';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests usage of constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $input_getter = $class->new({
+        title   => 'title-value',
+        message => 'message-value',
+        type    => 'type-value',
+        default => 'default-value',
+    });
+    isa_ok($input_getter, $class);
+    is($input_getter->get_title(), 'title-value', "$prefix: get title");
+    is($input_getter->get_message(), 'message-value', "$prefix: get message");
+    is($input_getter->get_type(), 'type-value', "$prefix: get type");
+    is($input_getter->get_default(), 'default-value', "$prefix: get default");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Interactive/InputGetter/CLI.pm
===================================================================
--- vendors/FCM/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 9621)
+++ vendors/FCM/t/Fcm/Interactive/InputGetter/CLI.pm	(revision 9621)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Interactive::InputGetter::CLI';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests usage of constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $input_getter = $class->new({});
+    isa_ok($input_getter, $class);
+}
+
+# TODO: tests the invoke method
+
+__END__
Index: vendors/FCM/t/Fcm/Interactive/InputGetter/GUI.t
===================================================================
--- vendors/FCM/t/Fcm/Interactive/InputGetter/GUI.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Interactive/InputGetter/GUI.t	(revision 9621)
@@ -0,0 +1,34 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Interactive::InputGetter::GUI';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests usage of constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my $input_getter = $class->new({
+        title   => 'title-value',
+        message => 'message-value',
+        type    => 'type-value',
+        default => 'default-value',
+        geometry => 'geometry-value',
+    });
+    isa_ok($input_getter, $class);
+    is($input_getter->get_geometry(), 'geometry-value', "$prefix: geometry");
+}
+
+# TODO: tests the invoke method
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword.t	(revision 9621)
@@ -0,0 +1,323 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Carp qw{croak};
+use Fcm::Keyword::Config;
+use Test::More (tests => 227);
+
+BEGIN: {
+    use_ok('Fcm::Keyword');
+}
+
+if (!caller()) {
+    main(@ARGV);
+}
+
+sub main {
+    local @ARGV = @_;
+    local %Fcm::Keyword::Config::CONFIG_OF = (
+        LOCATION_ENTRIES => {entry_class => 'Fcm::Keyword::Entry::Location'},
+        REVISION_ENTRIES => {entry_class => 'Fcm::Keyword::Entry'},
+    );
+    test_get_prefix_of_location_keyword();
+    test_get_entries();
+    test_expand();
+    test_unexpand();
+    test_get_browser_url();
+}
+
+################################################################################
+# Tests get_prefix_of_location_keyword().
+sub test_get_prefix_of_location_keyword {
+    is(Fcm::Keyword::get_prefix_of_location_keyword(), 'fcm');
+    is(Fcm::Keyword::get_prefix_of_location_keyword(1), 'fcm:');
+}
+
+################################################################################
+# Tests get_entries().
+sub test_get_entries {
+    my $entries = Fcm::Keyword::get_entries();
+    isa_ok($entries, 'Fcm::Keyword::Entries');
+    for (1 .. 10) {
+        is(Fcm::Keyword::get_entries(), $entries, "get_entries: is singleton");
+    }
+    isnt(Fcm::Keyword::get_entries(1), $entries, "get_entries: can reset");
+}
+
+################################################################################
+# Tests expand().
+sub test_expand {
+    my $T = 'expand';
+
+    # Add some keywords for testing
+    _add_keyword_entries([
+    #   ['name'  , 'value'                   , {'rev1' => rev, ...}],
+        ['FOO'   , 'test://foo/foo'      , {'V1.0' => 256, 'V1-1' => 4790}],
+        ['FOO-TR', 'test://foo/foo/trunk', {}],
+    ]);
+
+    _do_keyword_tests($T, \&Fcm::Keyword::expand, [
+    # Tests to ensure that valid targets are expanded
+    #   [['input'               ], ['expected'                     ]],
+        [['fcm:FOO'             ], ['test://foo/foo'               ]],
+        [['fcm:FOO'     , 'V1.0'], ['test://foo/foo'       , '256' ]],
+        [['fcm:Foo'             ], ['test://foo/foo'               ]],
+        [['fcm:foo'             ], ['test://foo/foo'               ]],
+        [['fcm:foo'     , 'v1.0'], ['test://foo/foo'       , '256' ]],
+        [['fcm:foo'     , 'head'], ['test://foo/foo'       , 'head']],
+        [['fcm:foo/'            ], ['test://foo/foo/'              ]],
+        [['fcm:foo/'    , '1234'], ['test://foo/foo/'      , '1234']],
+        [['fcm:foo/'    , 'v1.0'], ['test://foo/foo/'      , '256' ]],
+        [['fcm:foo/'    , 'v1-1'], ['test://foo/foo/'      , '4790']],
+        [['fcm:foo/bar'         ], ['test://foo/foo/bar'           ]],
+        [['fcm:foo/bar' , 'PREV'], ['test://foo/foo/bar'   , 'PREV']],
+        [['fcm:foo/bar' , 'base'], ['test://foo/foo/bar'   , 'base']],
+        [['fcm:foo/bar' , 'v1-1'], ['test://foo/foo/bar'   , '4790']],
+        [['fcm:foo/bar/', '7777'], ['test://foo/foo/bar/'  , '7777']],
+        [['fcm:foo/bar/', '{11}'], ['test://foo/foo/bar/'  , '{11}']],
+        [['fcm:foo/bar/', 'v1.0'], ['test://foo/foo/bar/'  , '256' ]],
+        [['fcm:foo-tr'          ], ['test://foo/foo/trunk'         ]],
+        [['fcm:foo-tr'  , 'head'], ['test://foo/foo/trunk' , 'head']],
+        [['fcm:foo-tr'  , 'v1.0'], ['test://foo/foo/trunk' , '256' ]],
+        [['fcm:foo-tr/'         ], ['test://foo/foo/trunk/'        ]],
+        [['fcm:foo-tr/' , '1234'], ['test://foo/foo/trunk/', '1234']],
+        [['fcm:foo-tr/' , 'v1-1'], ['test://foo/foo/trunk/', '4790']],
+    # Tests to ensure that non-keyword targets are not expanded
+    #   [['input'                     ]], # 'expected' same as 'input'
+        [['no-change'                 ]],
+        [['foo/bar'                   ]],
+        [['/foo/bar'                  ]],
+        [['/foo/bar'     , 'head'     ]],
+        [['/foo/bar/'                 ]],
+        [['/foo/bar/'    , 'not-a-key']],
+        [['svn://foo/bar'             ]],
+        [['svn://foo/bar', '1234'     ]],
+        [['file://foo/bar'            ]],
+        [['http://foo/bar'            ]],
+    ]);
+
+    # Tests for unexpected keywords
+    for my $key (qw{foo bar baz}) {
+        eval {
+            Fcm::Keyword::expand("fcm:foo\@$key");
+        };
+        isa_ok($@, 'Fcm::Keyword::Exception', "$T: $key: invalid revision");
+    }
+
+    # Tests for "undef", all expecting exceptions
+    for my $target_ref ([undef], [undef, undef], [undef, 'foo']) {
+        eval {
+            Fcm::Keyword::expand(@{$target_ref});
+        };
+        isa_ok($@, 'Fcm::Exception', "$T: undef");
+    }
+}
+
+################################################################################
+# Tests unexpand().
+sub test_unexpand {
+    my $T = 'unexpand';
+
+    # Add some keywords for testing
+    _add_keyword_entries([
+    #   ['name'  , 'value'               , {'rev1' => rev, ...}],
+        ['FOO'   , 'test://foo/foo'      , {'V1.0' => 256, 'V1-1' => 4790}],
+        ['FOO_TR', 'test://foo/foo/trunk', {}],
+        ['FOO-TR', 'test://foo/foo/trunk', {}],
+    ]);
+
+    _do_keyword_tests($T, \&Fcm::Keyword::unexpand, [
+    # Tests to ensure that valid targets are expanded
+    #   [['input'                        ], ['expected'            ]],
+        [['test://foo/foo'               ], ['fcm:FOO'             ]],
+        [['test://foo/foo'       , '256' ], ['fcm:FOO'     , 'V1.0']],
+        [['test://foo/foo'       , 'head'], ['fcm:FOO'     , 'head']],
+        [['test://foo/foo/'              ], ['fcm:FOO/'            ]],
+        [['test://foo/foo/'      , '1234'], ['fcm:FOO/'    , '1234']],
+        [['test://foo/foo/'      , '256' ], ['fcm:FOO/'    , 'V1.0']],
+        [['test://foo/foo/'      , '4790'], ['fcm:FOO/'    , 'V1-1']],
+        [['test://foo/foo/bar'           ], ['fcm:FOO/bar'         ]],
+        [['test://foo/foo/bar'   , 'PREV'], ['fcm:FOO/bar' , 'PREV']],
+        [['test://foo/foo/bar'   , 'base'], ['fcm:FOO/bar' , 'base']],
+        [['test://foo/foo/bar'   , '4790'], ['fcm:FOO/bar' , 'V1-1']],
+        [['test://foo/foo/bar/'  , '7777'], ['fcm:FOO/bar/', '7777']],
+        [['test://foo/foo/bar/'  , '{11}'], ['fcm:FOO/bar/', '{11}']],
+        [['test://foo/foo/bar/'  , '256' ], ['fcm:FOO/bar/', 'V1.0']],
+        [['test://foo/foo/trunk'         ], ['fcm:FOO-TR'          ]],
+        [['test://foo/foo/trunk' , 'head'], ['fcm:FOO-TR'  , 'head']],
+        [['test://foo/foo/trunk' , '256' ], ['fcm:FOO-TR'  , 'V1.0']],
+        [['test://foo/foo/trunk/'        ], ['fcm:FOO-TR/'         ]],
+        [['test://foo/foo/trunk/', '1234'], ['fcm:FOO-TR/' , '1234']],
+        [['test://foo/foo/trunk/', '4790'], ['fcm:FOO-TR/' , 'V1-1']],
+    # Tests to ensure that non-keyword targets are not expanded
+    #   [['input'                     ]], # 'expected' same as 'input'
+        [['no-change'                 ]],
+        [['foo/bar'                   ]],
+        [['/foo/bar'                  ]],
+        [['/foo/bar'     , 'head'     ]],
+        [['/foo/bar/'                 ]],
+        [['/foo/bar/'    , 'not-a-key']],
+        [['svn://foo/bar'             ]],
+        [['svn://foo/bar', '1234'     ]],
+        [['file://foo/bar'            ]],
+        [['http://foo/bar'            ]],
+    ]);
+
+    # Tests for "undef", all expecting exceptions
+    for my $target_ref ([undef], [undef, undef], [undef, 'foo']) {
+        eval {
+            Fcm::Keyword::unexpand(@{$target_ref});
+        };
+        isa_ok($@, 'Fcm::Exception', "$T: undef");
+    }
+}
+
+################################################################################
+# Tests get_browser_url().
+sub test_get_browser_url {
+    my $T = 'get_browser_url';
+
+    # Add some keywords for testing
+    _add_keyword_entries([
+    #   ['name'  , 'value'                        , {'rev1' => rev, ...}],
+        ['FOO'   , 'test://foo/foo_svn/foo'       , {'V1' => 256, 'W2' => 479}],
+        ['FOO-TR', 'test://foo/foo_svn/foo/trunk'],
+        ['FOO_TR', 'test://foo/foo_svn/foo/trunk'],
+    ]);
+
+    my ($INPUT, $EXPECTED) = (0, 1);
+    my ($LOC, $REV) = (0, 1);
+    for my $test_ref (
+    # Tests to ensure that valid targets are expanded
+    #   [['input'                                ], 'expected'                                                ],
+        [['test://foo/foo_svn/foo'               ], 'http://foo/projects/foo/intertrac/source:foo'            ],
+        [['test://foo/foo_svn/foo'       , '256' ], 'http://foo/projects/foo/intertrac/source:foo@256'        ],
+        [['test://foo/foo_svn/foo'       , 'head'], 'http://foo/projects/foo/intertrac/source:foo@head'       ],
+        [['test://foo/foo_svn/foo/'              ], 'http://foo/projects/foo/intertrac/source:foo/'           ],
+        [['test://foo/foo_svn/foo/'      , '1234'], 'http://foo/projects/foo/intertrac/source:foo/@1234'      ],
+        [['test://foo/foo_svn/foo/'      , '256' ], 'http://foo/projects/foo/intertrac/source:foo/@256'       ],
+        [['test://foo/foo_svn/foo/'      , '479' ], 'http://foo/projects/foo/intertrac/source:foo/@479'       ],
+        [['test://foo/foo_svn/foo/bar'           ], 'http://foo/projects/foo/intertrac/source:foo/bar'        ],
+        [['test://foo/foo_svn/foo/bar'   , '479' ], 'http://foo/projects/foo/intertrac/source:foo/bar@479'    ],
+        [['test://foo/foo_svn/foo/bar/'  , '7777'], 'http://foo/projects/foo/intertrac/source:foo/bar/@7777'  ],
+        [['test://foo/foo_svn/foo/bar/'  , '{11}'], 'http://foo/projects/foo/intertrac/source:foo/bar/@{11}'  ],
+        [['test://foo/foo_svn/foo/bar/'  , '256' ], 'http://foo/projects/foo/intertrac/source:foo/bar/@256'   ],
+        [['test://foo/foo_svn/foo/trunk'         ], 'http://foo/projects/foo/intertrac/source:foo/trunk'      ],
+        [['test://foo/foo_svn/foo/trunk' , 'head'], 'http://foo/projects/foo/intertrac/source:foo/trunk@head' ],
+        [['test://foo/foo_svn/foo/trunk' , '256' ], 'http://foo/projects/foo/intertrac/source:foo/trunk@256'  ],
+        [['test://foo/foo_svn/foo/trunk/'        ], 'http://foo/projects/foo/intertrac/source:foo/trunk/'     ],
+        [['test://foo/foo_svn/foo/trunk/', '1234'], 'http://foo/projects/foo/intertrac/source:foo/trunk/@1234'],
+        [['test://foo/foo_svn/foo/trunk/', '479' ], 'http://foo/projects/foo/intertrac/source:foo/trunk/@479' ],
+        [['fcm:FOO'                              ], 'http://foo/projects/foo/intertrac/source:foo'            ],
+        [['fcm:FOO'                      , 'V1'  ], 'http://foo/projects/foo/intertrac/source:foo@256'        ],
+        [['fcm:FOO'                      , 'head'], 'http://foo/projects/foo/intertrac/source:foo@head'       ],
+        [['fcm:FOO/'                             ], 'http://foo/projects/foo/intertrac/source:foo/'           ],
+        [['fcm:FOO/'                     , '1234'], 'http://foo/projects/foo/intertrac/source:foo/@1234'      ],
+        [['fcm:FOO/'                     , 'V1'  ], 'http://foo/projects/foo/intertrac/source:foo/@256'       ],
+        [['fcm:FOO/'                     , 'W2'  ], 'http://foo/projects/foo/intertrac/source:foo/@479'       ],
+        [['fcm:FOO/bar'                          ], 'http://foo/projects/foo/intertrac/source:foo/bar'        ],
+        [['fcm:FOO/bar'                  , 'W2'  ], 'http://foo/projects/foo/intertrac/source:foo/bar@479'    ],
+        [['fcm:FOO/bar/'                 , '7777'], 'http://foo/projects/foo/intertrac/source:foo/bar/@7777'  ],
+        [['fcm:FOO/bar/'                 , '{11}'], 'http://foo/projects/foo/intertrac/source:foo/bar/@{11}'  ],
+        [['fcm:FOO/bar/'                 , 'v1'  ], 'http://foo/projects/foo/intertrac/source:foo/bar/@256'   ],
+        [['fcm:FOO-TR'                           ], 'http://foo/projects/foo/intertrac/source:foo/trunk'      ],
+        [['fcm:FOO-TR'                   , 'head'], 'http://foo/projects/foo/intertrac/source:foo/trunk@head' ],
+        [['fcm:FOO-TR'                   , 'V1'  ], 'http://foo/projects/foo/intertrac/source:foo/trunk@256'  ],
+        [['fcm:FOO-TR/'                          ], 'http://foo/projects/foo/intertrac/source:foo/trunk/'     ],
+        [['fcm:FOO-TR/'                  , '1234'], 'http://foo/projects/foo/intertrac/source:foo/trunk/@1234'],
+        [['fcm:FOO-TR/'                  , 'w2'  ], 'http://foo/projects/foo/intertrac/source:foo/trunk/@479' ],
+    ) {
+        my $input = $test_ref->[$INPUT][$LOC];
+        if (exists($test_ref->[$INPUT][$REV])) {
+            $input .= '@' . $test_ref->[$INPUT][$REV];
+        }
+        for (
+            {name => "$T: scalar input: $input", input => [$input]},
+            {name => "$T: list input: $input"  , input => $test_ref->[$INPUT]},
+        ) {
+            my $output;
+            eval {
+                $output = Fcm::Keyword::get_browser_url(@{$_->{input}});
+                is($output, $test_ref->[$EXPECTED], $_->{name});
+            };
+            if ($@) {
+                fail("$_->{name}: $@");
+            }
+        }
+    }
+
+    # Tests correct behaviour for "undef"
+    for my $bad_url (undef, '') {
+        eval {
+            Fcm::Keyword::get_browser_url($bad_url);
+        };
+        isa_ok($@, 'Fcm::Exception', sprintf(
+            "$T: %s", (defined($bad_url) ? $bad_url : 'undef'),
+        ));
+    }
+
+    # Tests correct behaviour for invalid inputs
+    for my $bad_url ('foo', 'svn://no/such/url', 'fcm:no_such_project/trunk') {
+        eval {
+            Fcm::Keyword::get_browser_url($bad_url);
+        };
+        isa_ok($@, 'Fcm::Keyword::Exception', "$T: $bad_url: invalid keyword");
+    }
+}
+
+################################################################################
+# Adds keyword entries.
+sub _add_keyword_entries {
+    my ($items_ref) = @_;
+    my ($NAME, $LOC, $REV) = (0 .. 2);
+    my $entries = Fcm::Keyword::get_entries(1); # reset
+    for my $item_ref (@{$items_ref}) {
+        my $entry = $entries->add_entry($item_ref->[$NAME], $item_ref->[$LOC]);
+        while (my ($key, $value) = each(%{$item_ref->[$REV]})) {
+            $entry->get_revision_entries()->add_entry($key, $value);
+        }
+    }
+}
+
+################################################################################
+# Performs keyword testings.
+sub _do_keyword_tests {
+    my ($T, $action_ref, $tests_ref) = @_;
+    my ($INPUT, $EXPECTED) = (0, 1);
+    my ($LOC, $REV) = (0, 1);
+    for my $test_ref (@{$tests_ref}) {
+        if (!defined($test_ref->[$EXPECTED])) {
+            $test_ref->[$EXPECTED] = $test_ref->[$INPUT];
+        }
+        my %value_of;
+        for my $i (0 .. $#{$test_ref}) {
+            $value_of{$i} = $test_ref->[$i][$LOC];
+            if (exists($test_ref->[$i][$REV])) {
+                $value_of{$i} .= '@' . $test_ref->[$i][$REV];
+            }
+        }
+        eval {
+            is(
+                $action_ref->($value_of{$INPUT}), $value_of{$EXPECTED},
+                "$T: scalar context: $value_of{$INPUT}",
+            );
+        };
+        if ($@) {
+            fail("$T: scalar context: $value_of{$INPUT}: $@");
+        }
+        eval {
+            is_deeply(
+                [$action_ref->(@{$test_ref->[$INPUT]})],
+                $test_ref->[$EXPECTED],
+                "$T: list context: $value_of{$INPUT}",
+            );
+        };
+        if ($@) {
+            fail("$T: list context: $value_of{$INPUT}: $@");
+        }
+    }
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Config.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Config.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Config.t	(revision 9621)
@@ -0,0 +1,15 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $module = 'Fcm::Keyword::Config';
+    use_ok($module);
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Entries.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Entries.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Entries.t	(revision 9621)
@@ -0,0 +1,228 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A Fcm::Keyword::Entry sub-class for testing
+{
+    package TestEntry;
+    use base qw{Fcm::Keyword::Entry};
+}
+
+################################################################################
+# A mock loader implementing the Fcm::Keyword::Loader interface
+{
+    package MockLoader0;
+    use Scalar::Util qw{blessed};
+
+    ############################################################################
+    # Constructor
+    sub new {
+        my ($class) = @_;
+        return bless({number_of_calls_to_load_to => 0}, $class);
+    }
+
+    ############################################################################
+    ##Returns the package name
+    sub get_source {
+        my ($self) = @_;
+        return blessed($self);
+    }
+
+    ############################################################################
+    # Returns number of times $self->load_to() has been called
+    sub get_number_of_calls_to_load_to {
+        my ($self) = @_;
+        return $self->{number_of_calls_to_load_to};
+    }
+
+    ############################################################################
+    # Loads data into $entries, and returns number of entries loaded
+    sub load_to {
+        my ($self, $entries) = @_;
+        $self->{number_of_calls_to_load_to}++;
+        return $self->load_to_impl($entries);
+    }
+
+    ############################################################################
+    # Returns 0
+    sub load_to_impl {
+        my ($self, $entries) = @_;
+        return 0;
+    }
+}
+
+################################################################################
+# A mock loader implementing the Fcm::Keyword::Loader interface
+{
+    package MockLoader1;
+    our @ISA = qw{MockLoader0};
+
+    my %VALUE_OF = (foo => 'foo1', bar => 'bar2', baz => 'baz3');
+
+    ############################################################################
+    # Returns a reference to the mock data
+    sub get_data {
+        my ($class) = @_;
+        return \%VALUE_OF;
+    }
+
+    ############################################################################
+    ##Writes mock data to the $entries object
+    sub load_to_impl {
+        my ($self, $entries) = @_;
+        my $counter = 0;
+        for my $key (keys(%{$self->get_data()})) {
+            $entries->add_entry($key, $self->get_data()->{$key});
+            $counter++;
+        }
+        return $counter;
+    }
+}
+
+################################################################################
+# A mock loader implementing the Fcm::Keyword::Loader interface
+{
+    package MockLoader2;
+    our @ISA = qw{MockLoader1};
+
+    my %VALUE_OF = (sausages => 'pig', eggs => 'hen', chips => 'potato');
+
+    ############################################################################
+    # Returns a reference to the mock data
+    sub get_data {
+        my ($class) = @_;
+        return \%VALUE_OF;
+    }
+}
+
+package main;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Entries';
+    use_ok($class);
+    test_empty_constructor($class);
+    test_constructor($class);
+    test_add_entry($class);
+    test_loaders($class);
+}
+
+################################################################################
+# Tests empty constructor
+sub test_empty_constructor {
+    my ($class) = @_;
+    my $prefix = 'empty constructor';
+    my $entries = $class->new();
+    isa_ok($entries, $class);
+    is($entries->get_entry_class(), 'Fcm::Keyword::Entry',
+        "$prefix: default entry class");
+    is_deeply([$entries->get_loaders()], [], "$prefix: empty list of loaders");
+    is_deeply([$entries->get_all_entries()], [],
+        "$prefix: empty list of entries");
+    for my $arg ('foo', undef) {
+        is($entries->get_entry_by_key($arg), undef,
+            "$prefix: entry by key: undef");
+        is($entries->get_entry_by_value($arg), undef,
+            "$prefix: entry by value: undef");
+    }
+}
+
+################################################################################
+# Tests other constructor usages
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    my @loaders = (MockLoader1->new(), MockLoader2->new());
+    my $entries = $class->new({
+        entry_class => 'not-a-class',
+        loaders     => \@loaders,
+    });
+    isa_ok($entries, $class);
+    is($entries->get_entry_class(), 'not-a-class', "$prefix: entry class");
+    is_deeply([$entries->get_loaders()], \@loaders, "$prefix: list of loaders");
+    eval {
+        $entries->add_entry('key', 'value');
+    };
+    isnt($@, undef, "$prefix: invalid entry class");
+}
+
+################################################################################
+# Tests adding entries
+sub test_add_entry {
+    my ($class) = @_;
+    my $prefix = 'add entry';
+    my %VALUE_OF = (key1 => 'value1', egg => 'white and yolk', 'xyz.abc' => '');
+    for my $entry_class ('Fcm::Keyword::Entry', 'TestEntry') {
+        my $entries = $class->new({entry_class => $entry_class});
+        my $number_of_entries = 0;
+        for my $key (keys(%VALUE_OF)) {
+            my $entry = $entries->add_entry($key, $VALUE_OF{$key});
+            isa_ok($entry, $entry_class);
+            is(scalar(@{$entries->get_all_entries()}), ++$number_of_entries,
+                "$prefix: number of entries: $number_of_entries");
+        }
+        for my $key (keys(%VALUE_OF)) {
+            my $entry = $entries->get_entry_by_key($key);
+            isa_ok($entry, $entry_class);
+            is($entry->get_key(), uc($key), "$prefix: get by key: $key");
+            is($entry->get_value(), $VALUE_OF{$key},
+                "$prefix: get by key: $key: value");
+        }
+        for my $key (keys(%VALUE_OF)) {
+            my $entry = $entries->get_entry_by_value($VALUE_OF{$key});
+            isa_ok($entry, $entry_class);
+            is($entry->get_key(), uc($key), "$prefix: get by value: $key");
+            is($entry->get_value(), $VALUE_OF{$key},
+                "$prefix: get by value: $key: value");
+        }
+        is($entries->get_entry_by_key('no-such-key'), undef,
+            "$prefix: get by key: no-such-key");
+        is($entries->get_entry_by_value('no-such-value'), undef,
+            "$prefix: get by value: no-such-value");
+    }
+}
+
+################################################################################
+# Tests usage of loaders
+sub test_loaders {
+    my ($class) = @_;
+    my $prefix = "loader";
+    my @loaders = (MockLoader0->new(), MockLoader1->new(), MockLoader2->new());
+    my $entries = $class->new({loaders => \@loaders});
+    for my $loader (@loaders) {
+        is($loader->get_number_of_calls_to_load_to(), 0, "$prefix: not loaded");
+    }
+    for my $key (keys(%{$loaders[1]->get_data()})) {
+        my $value = $loaders[1]->get_data()->{$key};
+        my $entry = $entries->get_entry_by_key($key);
+        is($entry->get_key(), uc($key), "$prefix: by key: $key: key");
+        is($entries->get_entry_by_value($value), $entry,
+            "$prefix: by value: $key: object");
+    }
+    is($loaders[0]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: loaded once: 0");
+    is($loaders[1]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: loaded once: 1");
+    is($loaders[2]->get_number_of_calls_to_load_to(), 0,
+        "$prefix: not loaded: 2");
+    for my $key (keys(%{$loaders[2]->get_data()})) {
+        my $value = $loaders[2]->get_data()->{$key};
+        my $entry = $entries->get_entry_by_key($key);
+        is($entry->get_key(), uc($key), "$prefix: by key: $key: key");
+        is($entries->get_entry_by_value($value), $entry,
+            "$prefix: by value: $key: object");
+    }
+    is($loaders[0]->get_number_of_calls_to_load_to(), 2,
+        "$prefix: loaded once: 0");
+    is($loaders[1]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: loaded once: 1");
+    is($loaders[2]->get_number_of_calls_to_load_to(), 1,
+        "$prefix: not loaded: 2");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Entry.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Entry.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Entry.t	(revision 9621)
@@ -0,0 +1,26 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Entry';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = 'Fcm::Keyword::Entry';
+    my $entry = $class->new({key => 'key', value => 'value'});
+    isa_ok($entry, $class);
+    is($entry->get_key(), 'key', "normal: get_key()");
+    is($entry->get_value(), 'value', "normal: get_value()");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Entry/Location.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Entry/Location.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Entry/Location.t	(revision 9621)
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my ($class) = 'Fcm::Keyword::Entry::Location';
+    use_ok($class);
+    test_constructor($class);
+}
+
+################################################################################
+# Tests constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = 'constructor';
+    isa_ok($class->new(), $class, "$prefix: empty");
+    my $entry = $class->new({key => 'key', value => 'value'});
+    isa_ok($entry, $class, "$prefix: normal");
+    is($entry->get_key(), 'key', "$prefix: normal: get_key()");
+    is($entry->get_value(), 'value', "$prefix: normal: get_value()");
+    isa_ok($entry->get_revision_entries(), 'Fcm::Keyword::Entries');
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Exception.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Exception.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Exception.t	(revision 9621)
@@ -0,0 +1,27 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Exception';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $e = $class->new({message => 'message'});
+    isa_ok($e, $class, $prefix);
+    is("$e", "$class: message\n", "$prefix: as_string()");
+    is($e->get_message(), 'message', "$prefix: get_message()");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Formatter/Entries.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Formatter/Entries.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Formatter/Entries.t	(revision 9621)
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Keyword::Entries;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Formatter::Entries';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $formatter = $class->new();
+    isa_ok($formatter, $class, $prefix);
+    my $entries = Fcm::Keyword::Entries->new();
+    $entries->add_entry('foo', 'food');
+    $entries->add_entry('bar', 'barley');
+    is($formatter->format($entries), "BAR = barley\nFOO = food\n",
+        "$prefix: format");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Formatter/Entry.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Formatter/Entry.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Formatter/Entry.t	(revision 9621)
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Keyword::Entry;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Formatter::Entry';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $formatter = $class->new();
+    isa_ok($formatter, $class, $prefix);
+    my $entry = Fcm::Keyword::Entry->new({key => 'k', value => 'v'});
+    is($formatter->format($entry), "k = v\n", "$prefix: format");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Formatter/Entry/Location.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Formatter/Entry/Location.t	(revision 9621)
@@ -0,0 +1,28 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Keyword::Entry::Location;
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Formatter::Entry::Location';
+    use_ok($class);
+    test_normal($class);
+}
+
+################################################################################
+# Tests normal usage
+sub test_normal {
+    my ($class) = @_;
+    my $prefix = 'normal';
+    my $formatter = $class->new();
+    isa_ok($formatter, $class, $prefix);
+    my $entry = Fcm::Keyword::Entry::Location->new({key => 'k', value => 'v'});
+    like($formatter->format($entry), qr{k \s = \s v}xms, "$prefix: format");
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Loader/Config/Location.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Loader/Config/Location.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Loader/Config/Location.t	(revision 9621)
@@ -0,0 +1,68 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Config;
+use Fcm::Keyword::Entries;
+use Test::More qw{no_plan};
+
+my %VALUE_OF = (
+    foo => 'fcm-test://foo/foo',
+    bar => 'fcm-test://bar/bar',
+    baz => 'fcm-test://baz/baz',
+);
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Loader::Config::Location';
+    use_ok($class);
+    test_constructor($class);
+    test_load_to($class);
+}
+
+################################################################################
+# Tests simple usage of the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = "constructor";
+    my $loader = $class->new();
+    isa_ok($loader, $class);
+    is($loader->get_source(), 'Fcm::Config', "$prefix: get_source()");
+}
+
+################################################################################
+# Tests loading to an Fcm::Keyword::Entries object
+sub test_load_to {
+    my ($class) = @_;
+    my $prefix = 'load to';
+    my $config = Fcm::Config->instance();
+    for my $key (keys(%VALUE_OF)) {
+        $config->setting(['URL', $key], $VALUE_OF{$key});
+    }
+    my $loader = $class->new();
+    my $entries = Fcm::Keyword::Entries->new({
+        entry_class => 'Fcm::Keyword::Entry::Location',
+    });
+    isnt($loader->load_to($entries), 0, "$prefix: number loaded");
+    for my $key (keys(%VALUE_OF)) {
+        my $entry = $entries->get_entry_by_key($key);
+        if ($entry) {
+            is($entry->get_key(), uc($key), "$prefix: by key: $key");
+            is($entry->get_value(), $VALUE_OF{$key}, "$prefix: by value: $key");
+            is(
+                $entries->get_entry_by_value($VALUE_OF{$key}),
+                $entry,
+                "$prefix: by key: $key: object",
+            );
+        }
+        else {
+            fail("$prefix: by key: $key");
+        }
+    }
+}
+
+# TODO: tests loading of browser mapping
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Loader/Config/Revision.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Loader/Config/Revision.t	(revision 9621)
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Fcm::Config;
+use Fcm::Keyword::Entries;
+use Test::More qw{no_plan};
+
+my %VALUE_OF = (
+    bar => {
+        'bar3'    => 3,
+        'bar3.1'  => 31,
+        'bar3.14' => 314,
+    },
+    baz => {
+        'bear'   => 4,
+        'bee'    => 6,
+        'spider' => 8,
+    },
+);
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Loader::Config::Revision';
+    use_ok($class);
+    test_constructor($class);
+    test_load_to($class);
+}
+
+################################################################################
+# Tests simple usage of the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = "constructor";
+    my $loader = $class->new({namespace => 'namespace'});
+    isa_ok($loader, $class);
+    is($loader->get_namespace(), 'namespace', "$prefix: get_namespace()");
+    is($loader->get_source(), 'Fcm::Config', "$prefix: get_source()");
+}
+
+################################################################################
+# Tests loading to an Fcm::Keyword::Entries object
+sub test_load_to {
+    my ($class) = @_;
+    my $prefix = 'load to';
+    my $config = Fcm::Config->instance();
+    for my $key (keys(%VALUE_OF)) {
+        for my $rev_key (keys(%{$VALUE_OF{$key}})) {
+            my $value = $VALUE_OF{$key}{$rev_key};
+            $config->setting(['URL_REVISION', uc($key), uc($rev_key)], $value);
+        }
+        my $entries = Fcm::Keyword::Entries->new();
+        my $loader = $class->new({namespace => $key});
+        isnt($loader->load_to($entries), 0, "$prefix: number loaded");
+        for my $rev_key (keys(%{$VALUE_OF{$key}})) {
+            my $entry = $entries->get_entry_by_key($rev_key);
+            my $value = $VALUE_OF{$key}{$rev_key};
+            if ($entry) {
+                is(
+                    $entry->get_key(),
+                    uc($rev_key),
+                    "$prefix: by key: $rev_key",
+                );
+                is($entry->get_value(), $value, "$prefix: by value: $rev_key");
+                is(
+                    $entries->get_entry_by_value($value),
+                    $entry,
+                    "$prefix: by key: $key: object",
+                );
+            }
+            else {
+                fail("$prefix: by key: $rev_key");
+            }
+        }
+    }
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Keyword/Loader/VC/Revision.t
===================================================================
--- vendors/FCM/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Keyword/Loader/VC/Revision.t	(revision 9621)
@@ -0,0 +1,101 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Carp qw{croak};
+use Fcm::Keyword::Entries;
+use File::Basename qw{dirname};
+use File::Spec;
+use File::Temp qw{tempdir};
+use IO::File;
+use IO::Pipe;
+use POSIX qw{WIFEXITED};
+use Test::More (tests => 17);
+
+my %VALUE_OF = (
+    bar => {
+        'bar3'    => 3,
+        'bar3.1'  => 31,
+        'bar3.14' => 314,
+    },
+    baz => {
+        'bear'   => 4,
+        'bee'    => 6,
+        'spider' => 8,
+    },
+);
+
+main();
+
+sub main {
+    my $class = 'Fcm::Keyword::Loader::VC::Revision';
+    use_ok($class);
+    test_constructor($class);
+    test_load_to($class);
+}
+
+################################################################################
+# Tests simple usage of the constructor
+sub test_constructor {
+    my ($class) = @_;
+    my $prefix = "constructor";
+    my $loader = $class->new({source => 'foo'});
+    isa_ok($loader, $class);
+    is($loader->get_source(), 'foo', "$prefix: get_source()");
+    ok($loader->load_to(), "$prefix: load_to"); # FIXME: should fail?
+}
+
+################################################################################
+# Tests loading to an Fcm::Keyword::Entries object
+sub test_load_to {
+    my ($class) = @_;
+    my $prefix = 'load to';
+    my $temp_dir = tempdir(CLEANUP => 1);
+    my $repos = File::Spec->catfile($temp_dir, 'repos');
+    WIFEXITED(system(qw{svnadmin create}, $repos))
+        || croak("$repos: cannot create: $?");
+    my $dump_file = File::Spec->catfile(dirname($0), 'Revision.dump');
+    my $handle = IO::File->new($dump_file, 'r');
+    if (!$handle) {
+        croak("$dump_file: cannot load: $!");
+    }
+    my $dump = do{local $/; $handle->getline()};
+    $handle->close();
+    my $pipe = IO::Pipe->new();
+    $pipe->writer(qw{svnadmin load -q}, $repos);
+    print($pipe $dump);
+    $pipe->close();
+    if ($?) {
+        croak("$dump_file: cannot load: $?");
+    }
+    my $repos_url = "file://$repos";
+    my $loader = $class->new({source => $repos_url});
+    my $entries = Fcm::Keyword::Entries->new();
+    ok($loader->load_to($entries), "$prefix: nothing to load");
+    for my $key (keys(%VALUE_OF)) {
+        my $url = "$repos_url/$key";
+        my $loader = $class->new({source => $url});
+        $loader->load_to($entries);
+        for my $rev_key (keys(%{$VALUE_OF{$key}})) {
+            my $entry = $entries->get_entry_by_key($rev_key);
+            if ($entry) {
+                is(
+                    $entry->get_key(),
+                    uc($rev_key),
+                    "$prefix: by key: $rev_key",
+                );
+                is(
+                    $entries->get_entry_by_value($VALUE_OF{$key}{$rev_key}),
+                    $entry,
+                    "$prefix: by value: $rev_key: object",
+                );
+            }
+            else {
+                fail("$prefix: by key: $rev_key");
+            }
+        }
+    }
+}
+
+__END__
Index: vendors/FCM/t/Fcm/Util.t
===================================================================
--- vendors/FCM/t/Fcm/Util.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Util.t	(revision 9621)
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    use_ok('Fcm::Util');
+    test_tidy_url();
+}
+
+################################################################################
+# Tests tidy_url
+sub test_tidy_url {
+    my $prefix = "tidy_url";
+    my %RESULT_OF = (
+        ''                         => '',
+        'foo'                      => 'foo',
+        'foo/bar'                  => 'foo/bar',
+        'http://foo/bar'           => 'http://foo/bar',
+        'http://foo/bar@1234'      => 'http://foo/bar@1234',
+        'http://foo/bar/@1234'     => 'http://foo/bar@1234',
+        'http://foo/bar/.'         => 'http://foo/bar',
+        'http://foo/bar/.@1234'    => 'http://foo/bar@1234',
+        'http://foo/bar/./@1234'   => 'http://foo/bar@1234',
+        'http://foo/bar/./baz'     => 'http://foo/bar/baz',
+        'http://foo/bar/..'        => 'http://foo',
+        'http://foo/bar/..@1234'   => 'http://foo@1234',
+        'http://foo/bar/../@1234'  => 'http://foo@1234',
+        'http://foo/bar/../baz'    => 'http://foo/baz',
+        'http://foo/bar/../.'      => 'http://foo',
+        'http://foo/bar/baz/../..' => 'http://foo',
+    );
+    for my $key (sort keys(%RESULT_OF)) {
+        is(tidy_url($key), $RESULT_OF{$key}, "$prefix: $key");
+    }
+}
+
+# TODO: more unit tests
+
+__END__
Index: vendors/FCM/t/Fcm/Util/ClassLoader.t
===================================================================
--- vendors/FCM/t/Fcm/Util/ClassLoader.t	(revision 9621)
+++ vendors/FCM/t/Fcm/Util/ClassLoader.t	(revision 9621)
@@ -0,0 +1,55 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+################################################################################
+# A class for testing the loader
+{
+    package MyTestClass;
+
+    sub new {
+        my ($class) = @_;
+        return bless(\do{my $annon_scalar}, $class);
+    }
+}
+
+use Test::More qw{no_plan};
+
+main();
+
+sub main {
+    use_ok('Fcm::Util::ClassLoader');
+    test_normal();
+    test_bad();
+}
+
+################################################################################
+# Tests loading classes that should load OK
+sub test_normal {
+    my $prefix = 'normal';
+    my @CLASSES = (
+        'Fcm::CLI::Config',
+        'Fcm::Exception',
+        'Fcm::CLI::Config', # repeat
+        'MyTestClass',
+    );
+    for my $class (@CLASSES) {
+        ok(Fcm::Util::ClassLoader::load($class), "$prefix: load $class");
+    }
+}
+
+################################################################################
+# Tests loading classes that should fail
+sub test_bad {
+    my $prefix = 'bad';
+    my @CLASSES = ('Foo', 'Bar', 'Baz', 'No::Such::Class', 'Foo');
+    for my $class (@CLASSES) {
+        eval {
+            Fcm::Util::ClassLoader::load($class);
+        };
+        isa_ok($@, 'Fcm::Exception', "$prefix: load $class");
+    }
+}
+
+__END__
Index: vendors/IOIPSL/IOIPSL_License_CeCILL.txt
===================================================================
--- vendors/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 9621)
+++ vendors/IOIPSL/IOIPSL_License_CeCILL.txt	(revision 9621)
@@ -0,0 +1,36 @@
+The following licence information concerns ONLY the IOIPSL directory
+====================================================================
+
+Copyright (C) Institut Pierre Simon Laplace : IPSL
+
+This software is composed by a set of subroutines working as an
+interface between climate models and NETCDF files following CF
+convention. Library sources, examples of use and tools based on
+IOIPSL are provided. This library requires NetCDF library :
+http://www.unidata.ucar.edu/software/netcdf/
+
+This software is governed by the CeCILL license under French law and
+abiding by the rules of distribution of free software. You can use,
+modify and/or redistribute the software under the terms of the CeCILL
+license as circulated by CEA, CNRS and INRIA at the following URL
+"http://www.cecill.info".
+
+As a counterpart to the access to the source code and rights to copy,
+modify and redistribute granted by the license, users are provided only
+with a limited warranty and the software's author, the holder of the
+economic rights, and the successive licensors have only limited
+liability.
+
+In this respect, the user's attention is drawn to the risks associated
+with loading, using, modifying and/or developing or reproducing the
+software by the user in light of its specific status of free software,
+that may mean that it is complicated to manipulate, and that also
+therefore means that it is reserved for developers and experienced
+professionals having in-depth computer knowledge. Users are therefore
+encouraged to load and test the software's suitability as regards their
+requirements in conditions enabling the security of their systems and/or
+data to be ensured and, more generally, to use and operate it in the
+same conditions as regards security.
+
+The fact that you are presently reading this means that you have had
+knowledge of the CeCILL license and that you accept its terms.
Index: vendors/IOIPSL/src/calendar.f90
===================================================================
--- vendors/IOIPSL/src/calendar.f90	(revision 9621)
+++ vendors/IOIPSL/src/calendar.f90	(revision 9621)
@@ -0,0 +1,1044 @@
+MODULE calendar
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This is the calendar which going to be used to do all
+!- calculations on time. Three types of calendars are possible :
+!-
+!-  - gregorian :
+!-      The normal calendar. The time origin for the
+!-      julian day in this case is 24 Nov -4713
+!-      (other names : 'standard','proleptic_gregorian')
+!-  - noleap :
+!-      A 365 day year without leap years.
+!-      The origin for the julian days is in this case 1 Jan 0
+!-      (other names : '365_day','365d')
+!-  - all_leap :
+!-      A 366 day year with leap years.
+!-      The origin for the julian days is in this case ????
+!-      (other names : '366_day','366d'
+!-  - julian :
+!-      same as gregorian, but with all leap century years
+!-  - xxxd :
+!-      Year of xxx days with month of equal length.
+!-      The origin for the julian days is then also 1 Jan 0
+!-
+!- As one can see it is difficult to go from one calendar to the other.
+!- All operations involving julian days will be wrong.
+!- This calendar will lock as soon as possible
+!- the length of the year and forbid any further modification.
+!-
+!- For the non leap-year calendar the method is still brute force.
+!- We need to find an Integer series which takes care of the length
+!- of the various month. (Jan)
+!-
+!-   one_day  : one day in seconds
+!-   one_year : one year in days
+!---------------------------------------------------------------------
+  USE stringop,ONLY  : strlowercase
+  USE errioipsl,ONLY : ipslerr
+!-
+  PRIVATE
+  PUBLIC :: ymds2ju,ju2ymds,tlen2itau,isittime,ioconf_calendar, &
+ &          ioget_calendar,ioget_mon_len,ioget_year_len,itau2date, &
+ &          ioget_timestamp,ioconf_startdate,itau2ymds, &
+ &          time_diff,time_add,lock_calendar
+!-
+  INTERFACE ioget_calendar
+    MODULE PROCEDURE &
+ &    ioget_calendar_real1,ioget_calendar_real2,ioget_calendar_str
+  END INTERFACE
+!-
+  INTERFACE ioconf_startdate
+     MODULE PROCEDURE &
+ &    ioconf_startdate_simple,ioconf_startdate_internal, &
+ &    ioconf_startdate_ymds
+  END INTERFACE
+!-
+  REAL,PARAMETER :: one_day = 86400.0
+  LOGICAL,SAVE :: lock_startdate = .FALSE.
+!-
+  CHARACTER(LEN=30),SAVE :: time_stamp='XXXXXXXXXXXXXXXX'
+!-
+!- Description of calendar
+!-
+  CHARACTER(LEN=20),SAVE :: calendar_used="gregorian"
+  LOGICAL,SAVE :: lock_one_year = .FALSE.
+  REAL,SAVE :: one_year = 365.2425
+  INTEGER,SAVE :: mon_len(12)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+!-
+  CHARACTER(LEN=3),PARAMETER :: &
+ &  cal(12) = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+ &              'JUL','AUG','SEP','OCT','NOV','DEC'/)
+!-
+  REAL,SAVE :: start_day,start_sec
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE lock_calendar (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "lock_calendar" routine
+!! allows to lock or unlock the calendar,
+!! and to know the current status of the calendar.
+!! Be careful !
+!!
+!! SUBROUTINE lock_calendar (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the calendar
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the calendar
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = lock_one_year
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    lock_one_year = new_status
+  ENDIF
+!---------------------------
+END SUBROUTINE lock_calendar
+!-
+!===
+!-
+SUBROUTINE ymds2ju (year,month,day,sec,julian)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  REAL,INTENT(OUT) :: julian
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!-
+  julian = julian_day+julian_sec/one_day
+!---------------------
+END SUBROUTINE ymds2ju
+!-
+!===
+!-
+SUBROUTINE ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!---------------------------------------------------------------------
+!- Converts year, month, day and seconds into a julian day
+!-
+!- In 1968 in a letter to the editor of Communications of the ACM
+!- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
+!- and Thomas C. Van Flandern presented such an algorithm.
+!-
+!- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
+!-
+!- In the case of the Gregorian calendar we have chosen to use
+!- the Lilian day numbers. This is the day counter which starts
+!- on the 15th October 1582.
+!- This is the day at which Pope Gregory XIII introduced the
+!- Gregorian calendar.
+!- Compared to the true Julian calendar, which starts some
+!- 7980 years ago, the Lilian days are smaler and are dealt with
+!- easily on 32 bit machines. With the true Julian days you can only
+!- the fraction of the day in the real part to a precision of
+!- a 1/4 of a day with 32 bits.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  INTEGER,INTENT(OUT) :: julian_day
+  REAL,INTENT(OUT)    :: julian_sec
+!-
+  INTEGER :: jd,m,y,d,ml
+!---------------------------------------------------------------------
+  lock_one_year = .TRUE.
+!-
+  m = month
+  y = year
+  d = day
+!-
+!- We deduce the calendar from the length of the year as it
+!- is faster than an INDEX on the calendar variable.
+!-
+  IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!-- "Gregorian"
+    jd = (1461*(y+4800+INT((m-14)/12)))/4 &
+ &      +(367*(m-2-12*(INT((m-14)/12))))/12 &
+ &      -(3*((y+4900+INT((m-14)/12))/100))/4 &
+ &      +d-32075
+    jd = jd-2299160
+  ELSE IF (    (ABS(one_year-365.0) <= EPSILON(one_year))  &
+ &         .OR.(ABS(one_year-366.0) <= EPSILON(one_year)) ) THEN
+!-- "No leap" or "All leap"
+    ml = SUM(mon_len(1:m-1))
+    jd = y*NINT(one_year)+ml+(d-1)
+  ELSE
+!-- Calendar with regular month
+    ml = NINT(one_year/12.)
+    jd = y*NINT(one_year)+(m-1)*ml+(d-1)
+  ENDIF
+!-
+  julian_day = jd
+  julian_sec = sec
+!------------------------------
+END SUBROUTINE ymds2ju_internal
+!-
+!===
+!-
+SUBROUTINE ju2ymds (julian,year,month,day,sec)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(IN) :: julian
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  julian_day = INT(julian)
+  julian_sec = (julian-julian_day)*one_day
+!-
+  CALL ju2ymds_internal(julian_day,julian_sec,year,month,day,sec)
+!---------------------
+END SUBROUTINE ju2ymds
+!-
+!===
+!-
+SUBROUTINE ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine computes from the julian day the year,
+!- month, day and seconds
+!-
+!- In 1968 in a letter to the editor of Communications of the ACM
+!- (CACM, volume 11, number 10, October 1968, p.657) Henry F. Fliegel
+!- and Thomas C. Van Flandern presented such an algorithm.
+!-
+!- See also : http://www.magnet.ch/serendipity/hermetic/cal_stud/jdn.htm
+!-
+!- In the case of the Gregorian calendar we have chosen to use
+!- the Lilian day numbers. This is the day counter which starts
+!- on the 15th October 1582. This is the day at which Pope
+!- Gregory XIII introduced the Gregorian calendar.
+!- Compared to the true Julian calendar, which starts some 7980
+!- years ago, the Lilian days are smaler and are dealt with easily
+!- on 32 bit machines. With the true Julian days you can only the
+!- fraction of the day in the real part to a precision of a 1/4 of
+!- a day with 32 bits.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: julian_day
+  REAL,INTENT(IN)    :: julian_sec
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: l,n,i,jd,j,d,m,y,ml
+  INTEGER :: add_day
+  REAL :: eps_day
+!---------------------------------------------------------------------
+  eps_day = SPACING(one_day)
+  lock_one_year = .TRUE.
+!-
+  jd = julian_day
+  sec = julian_sec
+  IF (sec > (one_day-eps_day)) THEN
+    add_day = INT(sec/one_day)
+    sec = sec-add_day*one_day
+    jd = jd+add_day
+  ENDIF
+  IF (sec < -eps_day) THEN
+    sec = sec+one_day
+    jd = jd-1
+  ENDIF
+!-
+  IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!-- Gregorian
+    jd = jd+2299160
+!-
+    l = jd+68569
+    n = (4*l)/146097
+    l = l-(146097*n+3)/4
+    i = (4000*(l+1))/1461001
+    l = l-(1461*i)/4+31
+    j = (80*l)/2447
+    d = l-(2447*j)/80
+    l = j/11
+    m = j+2-(12*l)
+    y = 100*(n-49)+i+l
+  ELSE IF (    (ABS(one_year-365.0) <= EPSILON(one_year)) &
+ &         .OR.(ABS(one_year-366.0) <= EPSILON(one_year)) ) THEN
+!-- No leap or All leap
+    y = jd/NINT(one_year)
+    l = jd-y*NINT(one_year)
+    m = 1
+    ml = 0
+    DO WHILE (ml+mon_len(m) <= l)
+      ml = ml+mon_len(m)
+      m = m+1
+    ENDDO
+    d = l-ml+1
+  ELSE
+!-- others
+    ml = NINT(one_year/12.)
+    y = jd/NINT(one_year)
+    l = jd-y*NINT(one_year)
+    m = (l/ml)+1
+    d = l-(m-1)*ml+1
+  ENDIF
+!-
+  day = d
+  month = m
+  year = y
+!------------------------------
+END SUBROUTINE ju2ymds_internal
+!-
+!===
+!-
+SUBROUTINE tlen2itau (input_str,dt,date,itau)
+!---------------------------------------------------------------------
+!- This subroutine transforms a string containing a time length
+!- into a number of time steps.
+!- To do this operation the date (in julian days is needed as the
+!- length of the month varies.
+!- The following convention is used :
+!-   n   : n time steps
+!-   nS  : n seconds is transformed into itaus
+!-   nH  : n hours
+!-   nD  : n days
+!-   nM  : n month
+!-   nY  : n years
+!- Combinations are also possible
+!-   nYmD : nyears plus m days !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: input_str
+  REAL,INTENT(IN)             :: dt,date
+!-
+  INTEGER,INTENT(OUT)         :: itau
+!-
+  INTEGER           :: y_pos,m_pos,d_pos,h_pos,s_pos
+  INTEGER           :: read_time
+  CHARACTER(LEN=13) :: fmt
+  CHARACTER(LEN=80) :: tmp_str
+!-
+  INTEGER :: year,month,day
+  REAL    :: sec,date_new,dd,ss
+!---------------------------------------------------------------------
+  itau = 0
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  y_pos = MAX(INDEX(input_str,'y'),INDEX(input_str,'Y'))
+  m_pos = MAX(INDEX(input_str,'m'),INDEX(input_str,'M'))
+  d_pos = MAX(INDEX(input_str,'d'),INDEX(input_str,'D'))
+  h_pos = MAX(INDEX(input_str,'h'),INDEX(input_str,'H'))
+  s_pos = MAX(INDEX(input_str,'s'),INDEX(input_str,'S'))
+!-
+  IF (MAX(y_pos,m_pos,d_pos,s_pos) > 0) THEN
+    tmp_str = input_str
+    DO WHILE ( MAX(y_pos,m_pos,d_pos,s_pos) > 0)
+!---- WRITE(*,*) tmp_str
+!---- WRITE(*,*) y_pos,m_pos,d_pos,s_pos
+      IF (y_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') y_pos-1
+        READ(tmp_str(1:y_pos-1),fmt) read_time
+        CALL ymds2ju (year+read_time,month,day,sec,date_new)
+        dd = date_new-date
+        ss = INT(dd)*one_day+dd-INT(dd)
+        itau = itau+NINT(ss/dt)
+        tmp_str = tmp_str(y_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (m_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') m_pos-1
+        READ(tmp_str(1:m_pos-1),fmt) read_time
+        CALL ymds2ju (year,month+read_time,day,sec,date_new)
+        dd = date_new-date
+        ss = INT(dd)*one_day+dd-INT(dd)
+        itau = itau+NINT(ss/dt)
+        tmp_str = tmp_str(m_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (d_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') d_pos-1
+        READ(tmp_str(1:d_pos-1),fmt) read_time
+        itau = itau+NINT(read_time*one_day/dt)
+        tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF (h_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') h_pos-1
+        READ(tmp_str(1:h_pos-1),fmt) read_time
+        itau = itau+NINT(read_time*60.*60./dt)
+        tmp_str = tmp_str(d_pos+1:LEN_TRIM(tmp_str))
+      ELSE IF  (s_pos > 0) THEN
+        WRITE(fmt,'("(I",I10.10,")")') s_pos-1
+        READ(tmp_str(1:s_pos-1),fmt) read_time
+        itau = itau+NINT(read_time/dt)
+        tmp_str = tmp_str(s_pos+1:LEN_TRIM(tmp_str))
+      ENDIF
+!-
+      y_pos = MAX(INDEX(tmp_str,'y'),INDEX(tmp_str,'Y'))
+      m_pos = MAX(INDEX(tmp_str,'m'),INDEX(tmp_str,'M'))
+      d_pos = MAX(INDEX(tmp_str,'d'),INDEX(tmp_str,'D'))
+      h_pos = MAX(INDEX(tmp_str,'h'),INDEX(tmp_str,'H'))
+      s_pos = MAX(INDEX(tmp_str,'s'),INDEX(tmp_str,'S'))
+    ENDDO
+  ELSE
+    WRITE(fmt,'("(I",I10.10,")")') LEN_TRIM(input_str)
+    READ(input_str(1:LEN_TRIM(input_str)),fmt) itau
+  ENDIF
+!-----------------------
+END SUBROUTINE tlen2itau
+!-
+!===
+!-
+REAL FUNCTION itau2date (itau,date0,deltat)
+!---------------------------------------------------------------------
+!- This function transforms itau into a date. The date with which
+!- the time axis is going to be labeled
+!-
+!- INPUT
+!-   itau   : current time step
+!-   date0  : Date at which itau was equal to 0
+!-   deltat : time step between itau s
+!-
+!- OUTPUT
+!-   itau2date : Date for the given itau
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER  :: itau
+  REAL     :: date0,deltat
+!---------------------------------------------------------------------
+  itau2date = REAL(itau)*deltat/one_day+date0
+!---------------------
+END FUNCTION itau2date
+!-
+!===
+!-
+SUBROUTINE itau2ymds (itau,deltat,year,month,day,sec)
+!---------------------------------------------------------------------
+!- This subroutine transforms itau into a date. The date with which
+!- the time axis is going to be labeled
+!-
+!- INPUT
+!-   itau   : current time step
+!-   deltat : time step between itau s
+!-
+!- OUTPUT
+!-   year  : year
+!-   month : month
+!-   day   : day
+!-   sec   : seconds since midnight
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: deltat
+!-
+  INTEGER,INTENT(OUT) :: year,month,day
+  REAL,INTENT(OUT)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  IF (.NOT.lock_startdate) THEN
+    CALL ipslerr (2,'itau2ymds', &
+ &   'You try to call this function, itau2ymds, but you didn''t', &
+ &   ' call ioconf_startdate to initialize date0 in calendar.', &
+ &   ' Please call ioconf_startdate before itau2ymds.')
+  ENDIF
+  julian_day = start_day
+  julian_sec = start_sec+REAL(itau)*deltat
+  CALL ju2ymds_internal (julian_day,julian_sec,year,month,day,sec)
+!-----------------------
+END SUBROUTINE itau2ymds
+!-
+!===
+!-
+REAL FUNCTION dtchdate (itau,date0,old_dt,new_dt)
+!---------------------------------------------------------------------
+!- This function changes the date so that the simulation can
+!- continue with the same itau but a different dt.
+!-
+!- INPUT
+!-   itau   : current time step
+!-   date0  : Date at which itau was equal to 0
+!-   old_dt : Old time step between itaus
+!-   new_dt : New time step between itaus
+!-
+!- OUTPUT
+!-   dtchdate : Date for the given itau
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: date0,old_dt,new_dt
+!-
+  REAL :: rtime
+!---------------------------------------------------------------------
+  rtime = itau2date (itau,date0,old_dt)
+  dtchdate = rtime-REAL(itau)*new_dt/one_day
+!--------------------
+END FUNCTION dtchdate
+!-
+!===
+!-
+SUBROUTINE isittime &
+ &  (itau,date0,dt,freq,last_action,last_check,do_action)
+!---------------------------------------------------------------------
+!- This subroutine checks the time as come for a given action.
+!- This is computed from the current time-step(itau).
+!- Thus we need to have the time delta (dt), the frequency
+!- of the action (freq) and the last time it was done
+!- (last_action in units of itau).
+!- In order to extrapolate when will be the next check we need
+!- the time step of the last call (last_check).
+!-
+!- The test is done on the following condition :
+!- the distance from the current time to the time for the next
+!- action is smaller than the one from the next expected
+!- check to the next action.
+!- When the test is done on the time steps simplifications make
+!- it more difficult to read in the code.
+!- For the real time case it is easier to understand !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: itau
+  REAL,INTENT(IN)    :: dt,freq
+  INTEGER,INTENT(IN) :: last_action,last_check
+  REAL,INTENT(IN)    :: date0
+!-
+  LOGICAL,INTENT(OUT)  :: do_action
+!-
+  REAL :: dt_action,dt_check
+  REAL :: date_last_act,date_next_check,date_next_act, &
+ &        date_now,date_mp1,date_mpf
+  INTEGER :: year,month,monthp1,day,next_check_itau,next_act_itau
+  INTEGER :: yearp,dayp
+  REAL :: sec,secp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) THEN
+    WRITE(*,*) &
+ &    "isittime 1.0 ",itau,date0,dt,freq,last_action,last_check
+  ENDIF
+!-
+  IF (last_check >= 0) THEN
+    dt_action = (itau-last_action)*dt
+    dt_check = (itau-last_check)*dt
+    next_check_itau = itau+(itau-last_check)
+!-
+!-- We are dealing with frequencies in seconds and thus operation
+!-- can be done on the time steps.
+!-
+    IF (freq > 0) THEN
+      IF (ABS(dt_action-freq) <= ABS(dt_action+dt_check-freq)) THEN
+        do_action = .TRUE.
+      ELSE
+        do_action = .FALSE.
+      ENDIF
+!-
+!---- Here we deal with frequencies in month and work on julian days.
+!-
+    ELSE
+      date_now = itau2date (itau,date0,dt)
+      date_last_act = itau2date (last_action,date0,dt)
+      CALL ju2ymds (date_last_act,year,month,day,sec)
+      monthp1 = month-freq
+      yearp = year
+!-
+!---- Here we compute what logically should be the next month
+!-
+      DO WHILE (monthp1 >= 13)
+        yearp = yearp+1
+        monthp1 = monthp1-12
+      END DO
+      CALL ymds2ju (yearp,monthp1,day,sec,date_mpf)
+!-
+!---- But it could be that because of a shorter month or a bad
+!---- starting date that we end up further than we should be.
+!---- Thus we compute the first day of the next month.
+!---- We can not be beyond this date and if we are close
+!---- then we will take it as it is better.
+!-
+      monthp1 = month+ABS(freq)
+      yearp=year
+      DO WHILE (monthp1 >= 13)
+        yearp = yearp+1
+        monthp1 = monthp1-12
+      END DO
+      dayp = 1
+      secp = 0.0
+      CALL ymds2ju (yearp,monthp1,dayp,secp,date_mp1)
+!-
+!---- If date_mp1 is smaller than date_mpf or only less than 4 days
+!---- larger then we take it. This needed to ensure that short month
+!---- like February do not mess up the thing !
+!-
+      IF (date_mp1-date_mpf < 4.) THEN
+        date_next_act = date_mp1
+      ELSE
+        date_next_act = date_mpf
+      ENDIF
+      date_next_check = itau2date (next_check_itau,date0,dt)
+!-
+!---- Transform the dates into time-steps for the needed precisions.
+!-
+      next_act_itau = &
+ &      last_action+INT((date_next_act-date_last_act)*(one_day/dt))
+!-----
+      IF (   ABS(itau-next_act_itau) &
+ &        <= ABS( next_check_itau-next_act_itau)) THEN
+        do_action = .TRUE.
+        IF (check) THEN
+          WRITE(*,*) &
+ &         'ACT-TIME : itau, next_act_itau, next_check_itau : ', &
+ &         itau,next_act_itau,next_check_itau
+          CALL ju2ymds (date_now,year,month,day,sec)
+          WRITE(*,*) 'ACT-TIME : y, m, d, s : ',year,month,day,sec
+          WRITE(*,*) &
+ &         'ACT-TIME : date_mp1, date_mpf : ',date_mp1,date_mpf
+        ENDIF
+      ELSE
+        do_action = .FALSE.
+      ENDIF
+    ENDIF
+!-
+    IF (check) THEN
+      WRITE(*,*) "isittime 2.0 ", &
+ &     date_next_check,date_next_act,ABS(dt_action-freq), &
+ &     ABS(dt_action+dt_check-freq),dt_action,dt_check, &
+ &     next_check_itau,do_action
+    ENDIF
+  ELSE
+    do_action=.FALSE.
+  ENDIF
+!----------------------
+END SUBROUTINE isittime
+!-
+!===
+!-
+SUBROUTINE ioconf_calendar (str)
+!---------------------------------------------------------------------
+!- This routine allows to configure the calendar to be used.
+!- This operation is only allowed once and the first call to
+!- ymds2ju or ju2ymsd will lock the current configuration.
+!- the argument to ioconf_calendar can be any of the following :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: str
+!-
+  INTEGER :: leng,ipos
+  CHARACTER(LEN=20) :: str_w
+!---------------------------------------------------------------------
+!-
+! Clean up the string !
+!-
+  str_w = str
+  CALL strlowercase (str_w)
+!-
+  IF (.NOT.lock_one_year) THEN
+!---
+    lock_one_year=.TRUE.
+!---
+    SELECT CASE(TRIM(str_w))
+    CASE('gregorian','standard','proleptic_gregorian')
+      calendar_used = 'gregorian'
+      one_year = 365.2425
+      mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+    CASE('noleap','365_day','365d')
+      calendar_used = 'noleap'
+      one_year = 365.0
+      mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+    CASE('all_leap','366_day','366d')
+      calendar_used = 'all_leap'
+      one_year = 366.0
+      mon_len(:)=(/31,29,31,30,31,30,31,31,30,31,30,31/)
+    CASE('360_day','360d')
+      calendar_used = '360d'
+      one_year = 360.0
+      mon_len(:)=(/30,30,30,30,30,30,30,30,30,30,30,30/)
+    CASE('julian')
+      calendar_used = 'julian'
+      one_year = 365.25
+      mon_len(:)=(/31,28,31,30,31,30,31,31,30,31,30,31/)
+    CASE DEFAULT
+      ipos = INDEX(str_w,'d')
+      IF (ipos == 4) THEN
+        READ(str_w(1:3),'(I3)') leng
+        IF ( (MOD(leng,12) == 0).AND.(leng > 1) ) THEN
+          calendar_used = str_w
+          one_year = leng
+          mon_len(:) = leng/12
+        ELSE
+          CALL ipslerr (3,'ioconf_calendar', &
+ &         'The length of the year as to be a modulo of 12', &
+ &         'so that it can be divided into 12 month of equal length', &
+ &         TRIM(str_w))
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'ioconf_calendar', &
+ &       'Unrecognized input, please check the man pages.', &
+ &       TRIM(str_w),' ')
+      ENDIF
+    END SELECT
+  ELSE IF (TRIM(str_w) /= TRIM(calendar_used)) THEN
+    WRITE(str_w,'(f10.4)') one_year
+    CALL ipslerr (2,'ioconf_calendar', &
+ &   'The calendar was already used or configured to : '// &
+ &    TRIM(calendar_used)//'.', &
+ &   'You are not allowed to change it to : '//TRIM(str)//'.', &
+ &   'The following length of year is used : '//TRIM(ADJUSTL(str_w)))
+  ENDIF
+!-----------------------------
+END SUBROUTINE ioconf_calendar
+!-
+!===
+!-
+SUBROUTINE ioconf_startdate_simple (julian)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(IN) :: julian
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  julian_day = INT(julian)
+  julian_sec = (julian-julian_day)*one_day
+!-
+  CALL ioconf_startdate_internal (julian_day,julian_sec)
+!-------------------------------------
+END SUBROUTINE ioconf_startdate_simple
+!-
+!===
+!-
+SUBROUTINE ioconf_startdate_ymds (year,month,day,sec)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month,day
+  REAL,INTENT(IN)    :: sec
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal (year,month,day,sec,julian_day,julian_sec)
+!-
+  CALL ioconf_startdate_internal (julian_day,julian_sec)
+!-----------------------------------
+END SUBROUTINE ioconf_startdate_ymds
+!-
+!===
+!-
+SUBROUTINE ioconf_startdate_internal (julian_day,julian_sec)
+!---------------------------------------------------------------------
+! This subroutine allows to set the startdate for later
+! use. It allows the applications to access the date directly from
+! the timestep. In order to avoid any problems the start date will
+! be locked and can not be changed once set.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN)  :: julian_day
+  REAL,INTENT(IN)     :: julian_sec
+!-
+  CHARACTER(len=70) :: str70a,str70b
+!---------------------------------------------------------------------
+  IF (.NOT.lock_startdate) THEN
+    start_day = julian_day
+    start_sec = julian_sec
+    lock_startdate = .TRUE.
+  ELSE
+    WRITE(str70a,'("The date you tried to set : ",f10.4)') &
+ &   julian_day,julian_sec/one_day
+    WRITE(str70b, &
+ &   '("The date which was already set in the calendar : ",f10.4)') &
+ &   start_day+start_sec/one_day
+    CALL ipslerr (2,'ioconf_startdate', &
+ &   'The start date has already been set and you tried to change it', &
+ &   str70a,str70b)
+  ENDIF
+!---------------------------------------
+END SUBROUTINE ioconf_startdate_internal
+!-
+!===
+!-
+SUBROUTINE ioget_calendar_str (str)
+!---------------------------------------------------------------------
+!- This subroutine returns the name of the calendar used here.
+!- Three options exist :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!-
+!- This routine will lock the calendar.
+!- You do not want it to change after your inquiry.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(OUT) :: str
+!---------------------------------------------------------------------
+  lock_one_year = .TRUE.
+!-
+  str = calendar_used
+!--------------------------------
+END SUBROUTINE ioget_calendar_str
+!-
+!===
+!-
+SUBROUTINE ioget_calendar_real1 (long_year)
+!---------------------------------------------------------------------
+!- This subroutine returns the name of the calendar used here.
+!- Three options exist :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!-
+!- This routine will lock the calendar.
+!- You do not want it to change after your inquiry.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(OUT) :: long_year
+!---------------------------------------------------------------------
+  long_year = one_year
+  lock_one_year = .TRUE.
+!----------------------------------
+END SUBROUTINE ioget_calendar_real1
+!-
+!===
+!-
+SUBROUTINE ioget_calendar_real2 (long_year,long_day)
+!---------------------------------------------------------------------
+!- This subroutine returns the name of the calendar used here.
+!- Three options exist :
+!-  - gregorian : This is the gregorian calendar (default here)
+!-  - noleap    : A calendar without leap years = 365 days
+!-  - xxxd      : A calendar of xxx days (has to be a modulo of 12)
+!-                with 12 month of equal length
+!-
+!- This routine will lock the calendar.
+!- You do not want it to change after your inquiry.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL,INTENT(OUT) :: long_year,long_day
+!---------------------------------------------------------------------
+  long_year = one_year
+  long_day  = one_day
+  lock_one_year = .TRUE.
+!----------------------------------
+END SUBROUTINE ioget_calendar_real2
+!-
+!===
+!-
+INTEGER FUNCTION ioget_mon_len (year,month)
+!!--------------------------------------------------------------------
+!! The "ioget_mon_len" function returns
+!! the number of days in a "month" of a "year",
+!! in the current calendar.
+!!
+!! INTEGER FUNCTION ioget_mon_len (year,month)
+!!
+!! INPUT
+!!
+!! (I) year  : year
+!! (I) month : month in the year (1 --> 12)
+!!
+!! OUTPUT
+!!
+!! (I) ioget_mon_len : number of days in the month
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year,month
+!-
+  INTEGER :: ml
+!---------------------------------------------------------------------
+  IF ( (month >= 1).AND.(month <= 12) ) THEN
+    IF ( (one_year > 365.0).AND.(one_year < 366.0) ) THEN
+!---- "Gregorian" or "Julian"
+      ml = mon_len(month)
+      IF (month == 2) THEN
+        IF (ABS(one_year-365.2425) <= EPSILON(one_year) ) THEN
+!-------- "Gregorian"
+          IF (    ((MOD(year,4) == 0).AND.(MOD(year,100) /= 0)) &
+              .OR.(MOD(year,400) == 0) ) THEN
+            ml = ml+1
+          ENDIF
+        ELSE
+!-------- "Julian"
+          IF (MOD(year,4) == 0) THEN
+            ml = ml+1
+          ENDIF
+        ENDIF
+      ENDIF
+      ioget_mon_len = ml
+    ELSE
+!---- "No leap" or "All leap" or "Calendar with regular month"
+      ioget_mon_len = mon_len(month)
+    ENDIF
+  ELSE
+    CALL ipslerr (3,'ioget_mon_len', &
+ &    'The number of the month','must be between','1 and 12')
+  ENDIF
+!-------------------------
+END FUNCTION ioget_mon_len
+!-
+!===
+!-
+INTEGER FUNCTION ioget_year_len (year)
+!!--------------------------------------------------------------------
+!! The "ioget_year_len" function returns
+!! the number of days in "year", in the current calendar.
+!!
+!! INTEGER FUNCTION ioget_year_len (year)
+!!
+!! INPUT
+!!
+!! (I) year  : year
+!!
+!! OUTPUT
+!!
+!! (I) ioget_year_len : number of days in the year
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year
+!-
+  INTEGER :: yl
+!---------------------------------------------------------------------
+  SELECT CASE(TRIM(calendar_used))
+  CASE('gregorian')
+    yl = 365
+    IF (    ((MOD(year,4) == 0).AND.(MOD(year,100) /= 0)) &
+        .OR.(MOD(year,400) == 0) ) THEN
+      yl = yl+1
+    ENDIF
+  CASE('julian')
+    yl = 365
+    IF (MOD(year,4) == 0) THEN
+      yl = yl+1
+    ENDIF
+  CASE DEFAULT
+    yl = NINT(one_year)
+  END SELECT
+  ioget_year_len = yl
+!--------------------------
+END FUNCTION ioget_year_len
+!-
+!===
+!-
+SUBROUTINE ioget_timestamp (string)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=30),INTENT(OUT) :: string
+!-
+  INTEGER :: date_time(8)
+  CHARACTER(LEN=10) :: bigben(3)
+!---------------------------------------------------------------------
+  IF (INDEX(time_stamp,'XXXXXX') > 0) THEN
+    CALL DATE_AND_TIME (bigben(1),bigben(2),bigben(3),date_time)
+!---
+    WRITE(time_stamp, &
+ &   "(I4.4,'-',A3,'-',I2.2,' ',I2.2,':',I2.2,':',I2.2,' GMT',a5)") &
+ &   date_time(1),cal(date_time(2)),date_time(3),date_time(5), &
+ &   date_time(6),date_time(7),bigben(3)
+  ENDIF
+!-
+  string = time_stamp
+!-----------------------------
+END SUBROUTINE ioget_timestamp
+!-
+!===
+!-
+SUBROUTINE time_add &
+ &  (year_s,month_s,day_s,sec_s,sec_increment, &
+ &   year_e,month_e,day_e,sec_e)
+!---------------------------------------------------------------------
+!- This subroutine allows to increment a date by a number of seconds.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year_s,month_s,day_s
+  REAL,INTENT(IN)    :: sec_s
+!-
+! Time in seconds to be added to the date
+!-
+  REAL,INTENT(IN)    :: sec_increment
+!-
+  INTEGER,INTENT(OUT) :: year_e,month_e,day_e
+  REAL,INTENT(OUT)    :: sec_e
+!-
+  INTEGER :: julian_day
+  REAL    :: julian_sec
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal &
+ &  (year_s,month_s,day_s,sec_s,julian_day,julian_sec)
+!-
+  julian_sec = julian_sec+sec_increment
+!-
+  CALL ju2ymds_internal &
+ &  (julian_day,julian_sec,year_e,month_e,day_e,sec_e)
+!----------------------
+END SUBROUTINE time_add
+!-
+!===
+!-
+SUBROUTINE time_diff &
+ &  (year_s,month_s,day_s,sec_s,year_e,month_e,day_e,sec_e,sec_diff)
+!---------------------------------------------------------------------
+!- This subroutine allows to determine the number of seconds
+!- between two dates.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: year_s,month_s,day_s
+  REAL,INTENT(IN)    :: sec_s
+  INTEGER,INTENT(IN) :: year_e,month_e,day_e
+  REAL,INTENT(IN)    :: sec_e
+!-
+! Time in seconds between the two dates
+!-
+  REAL,INTENT(OUT)    :: sec_diff
+!-
+  INTEGER :: julian_day_s,julian_day_e,day_diff
+  REAL    :: julian_sec_s,julian_sec_e
+!---------------------------------------------------------------------
+  CALL ymds2ju_internal &
+ &  (year_s,month_s,day_s,sec_s,julian_day_s,julian_sec_s)
+  CALL ymds2ju_internal &
+ &  (year_e,month_e,day_e,sec_e,julian_day_e,julian_sec_e)
+!-
+  day_diff = julian_day_e-julian_day_s
+  sec_diff = julian_sec_e-julian_sec_s
+!-
+  sec_diff = sec_diff+day_diff*one_day
+!-----------------------
+END SUBROUTINE time_diff
+!-
+!===
+!-
+END MODULE calendar
Index: vendors/IOIPSL/src/defprec.f90
===================================================================
--- vendors/IOIPSL/src/defprec.f90	(revision 9621)
+++ vendors/IOIPSL/src/defprec.f90	(revision 9621)
@@ -0,0 +1,22 @@
+MODULE defprec 
+!-
+! $Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! The module "defprec" set default precision for computation
+!!
+!! This module should be used by every modules
+!! to keep the right precision for every variable
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER,PARAMETER :: i_1=SELECTED_INT_KIND(2)
+  INTEGER,PARAMETER :: i_2=SELECTED_INT_KIND(4)
+  INTEGER,PARAMETER :: i_4=SELECTED_INT_KIND(9)
+  INTEGER,PARAMETER :: i_8=SELECTED_INT_KIND(13)
+  INTEGER,PARAMETER :: r_4=SELECTED_REAL_KIND(6,37)
+  INTEGER,PARAMETER :: r_8=SELECTED_REAL_KIND(15,307)
+  INTEGER,PARAMETER :: i_std=i_4, r_std=r_8
+!-----------------
+END MODULE defprec
Index: vendors/IOIPSL/src/errioipsl.f90
===================================================================
--- vendors/IOIPSL/src/errioipsl.f90	(revision 9621)
+++ vendors/IOIPSL/src/errioipsl.f90	(revision 9621)
@@ -0,0 +1,215 @@
+MODULE errioipsl
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: ipslnlf, ipslerr, ipslerr_act, ipslerr_inq, histerr, ipsldbg
+!-
+  INTEGER :: n_l=6, ilv_cur=0, ilv_max=0
+  LOGICAL :: ioipsl_debug=.FALSE., lact_mode=.TRUE.
+!-
+!===
+CONTAINS
+!===
+SUBROUTINE ipslnlf (new_number,old_number)
+!!--------------------------------------------------------------------
+!! The "ipslnlf" routine allows to know and modify
+!! the current logical number for the messages.
+!!
+!! SUBROUTINE ipslnlf (new_number,old_number)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_number : new logical number of the file
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_number : current logical number of the file
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(IN)  :: new_number
+  INTEGER,OPTIONAL,INTENT(OUT) :: old_number
+!---------------------------------------------------------------------
+  IF (PRESENT(old_number)) THEN
+    old_number = n_l
+  ENDIF
+  IF (PRESENT(new_number)) THEN
+    n_l = new_number
+  ENDIF
+!---------------------
+END SUBROUTINE ipslnlf
+!===
+SUBROUTINE ipslerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!! The "ipslerr" routine
+!! allows to handle the messages to the user.
+!!
+!! INPUT
+!!
+!! plev   : Category of message to be reported to the user
+!!          1 = Note to the user
+!!          2 = Warning to the user
+!!          3 = Fatal error
+!! pcname : Name of subroutine which has called ipslerr
+!! pstr1   
+!! pstr2  : Strings containing the explanations to the user
+!! pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     ilv_cur = plev
+     ilv_max = MAX(ilv_max,plev)
+     WRITE(n_l,'(/,A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(n_l,'(3(" --> ",A,/))') TRIM(pstr1),TRIM(pstr2),TRIM(pstr3)
+   ENDIF
+   IF ( (plev == 3).AND.lact_mode) THEN
+     WRITE(n_l,'("Fatal error from IOIPSL. STOP in ipslerr with code")')
+     STOP 1
+   ENDIF
+!---------------------
+END SUBROUTINE ipslerr
+!===
+SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!--------------------------------------------------------------------
+!! The "ipslerr_act" routine allows to know and modify
+!! the current "action mode" for the error messages,
+!! and reinitialize the error level values.
+!!
+!! SUBROUTINE ipslerr_act (new_mode,old_mode)
+!!
+!! Optional INPUT argument
+!!
+!! (I) new_mode : new error action mode
+!!                .TRUE.  -> STOP     in case of fatal error
+!!                .FALSE. -> CONTINUE in case of fatal error
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) old_mode : current error action mode
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_mode
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_mode
+!---------------------------------------------------------------------
+  IF (PRESENT(old_mode)) THEN
+    old_mode = lact_mode
+  ENDIF
+  IF (PRESENT(new_mode)) THEN
+    lact_mode = new_mode
+  ENDIF
+  ilv_cur = 0
+  ilv_max = 0
+!-------------------------
+END SUBROUTINE ipslerr_act
+!===
+SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!--------------------------------------------------------------------
+!! The "ipslerr_inq" routine allows to know
+!! the current level of the error messages
+!! and the maximum level encountered since the
+!! last call to "ipslerr_act".
+!!
+!! SUBROUTINE ipslerr_inq (current_level,maximum_level)
+!!
+!! Optional OUTPUT argument
+!!
+!! (I) current_level : current error level
+!! (I) maximum_level : maximum error level
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,OPTIONAL,INTENT(OUT) :: current_level,maximum_level
+!---------------------------------------------------------------------
+  IF (PRESENT(current_level)) THEN
+    current_level = ilv_cur
+  ENDIF
+  IF (PRESENT(maximum_level)) THEN
+    maximum_level = ilv_max
+  ENDIF
+!-------------------------
+END SUBROUTINE ipslerr_inq
+!===
+SUBROUTINE histerr (plev,pcname,pstr1,pstr2,pstr3)
+!---------------------------------------------------------------------
+!- INPUT
+!- plev   : Category of message to be reported to the user
+!-          1 = Note to the user
+!-          2 = Warning to the user
+!-          3 = Fatal error
+!- pcname : Name of subroutine which has called histerr
+!- pstr1   
+!- pstr2  : String containing the explanations to the user
+!- pstr3
+!---------------------------------------------------------------------
+   IMPLICIT NONE
+!-
+   INTEGER :: plev
+   CHARACTER(LEN=*) :: pcname,pstr1,pstr2,pstr3
+!-
+   CHARACTER(LEN=30),DIMENSION(3) :: pemsg = &
+  &  (/ "NOTE TO THE USER FROM ROUTINE ", &
+  &     "WARNING FROM ROUTINE          ", &
+  &     "FATAL ERROR FROM ROUTINE      " /)
+!---------------------------------------------------------------------
+   IF ( (plev >= 1).AND.(plev <= 3) ) THEN
+     WRITE(*,'("     ")')
+     WRITE(*,'(A," ",A)') TRIM(pemsg(plev)),TRIM(pcname)
+     WRITE(*,'(" --> ",A)') pstr1
+     WRITE(*,'(" --> ",A)') pstr2
+     WRITE(*,'(" --> ",A)') pstr3
+   ENDIF
+   IF (plev == 3) THEN
+     STOP 'Fatal error from IOIPSL. See stdout for more details'
+   ENDIF
+!---------------------
+END SUBROUTINE histerr
+!===
+SUBROUTINE ipsldbg (new_status,old_status)
+!!--------------------------------------------------------------------
+!! The "ipsldbg" routine
+!! allows to activate or deactivate the debug,
+!! and to know the current status of the debug.
+!!
+!! SUBROUTINE ipsldbg (new_status,old_status)
+!!
+!! Optional INPUT argument
+!!
+!! (L) new_status : new status of the debug
+!!
+!! Optional OUTPUT argument
+!!
+!! (L) old_status : current status of the debug
+!!--------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,OPTIONAL,INTENT(IN)  :: new_status
+  LOGICAL,OPTIONAL,INTENT(OUT) :: old_status
+!---------------------------------------------------------------------
+  IF (PRESENT(old_status)) THEN
+    old_status = ioipsl_debug
+  ENDIF
+  IF (PRESENT(new_status)) THEN
+    ioipsl_debug = new_status
+  ENDIF
+!---------------------
+END SUBROUTINE ipsldbg
+!===
+!-------------------
+END MODULE errioipsl
Index: vendors/IOIPSL/src/flincom.f90
===================================================================
--- vendors/IOIPSL/src/flincom.f90	(revision 9621)
+++ vendors/IOIPSL/src/flincom.f90	(revision 9621)
@@ -0,0 +1,1939 @@
+MODULE flincom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  USE calendar,  ONLY : ju2ymds, ymds2ju, ioconf_calendar
+  USE errioipsl, ONLY : histerr
+  USE stringop,  ONLY : strlowercase
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: flinput, flincre, flinget, flinclo, &
+            flinopen, flininfo, flininspect, flinquery_var
+!-
+  INTERFACE flinopen
+!---------------------------------------------------------------------
+!- The "flinopen" routines will open an input file
+!-
+!- INPUT
+!-
+!- filename  : Name of the netCDF file to be opened
+!-
+!- iideb     : index i for zoom     !
+!- iilen     : length  of  zoom     !   for
+!- jjdeb     : index j for zoom     !   zoom
+!- jjlen     : length  of  zoom     !
+!-
+!- do_test   : A flag that enables the testing of the content
+!-             of the file against the input from the model
+!-
+!- INPUT if do_test=TRUE      OUTPUT else
+!-
+!- iim       : size in the x direction in the file (longitude)
+!- jjm       : size in the y direction
+!- llm       : number of levels
+!-             (llm = 0 means no axis to be expected)
+!- lon       : array of (iilen,jjlen) (zoom), or (iim,jjm) (no zoom),
+!-             that contains the longitude of each point
+!- lat       : same for latitude
+!- lev       : An array of llm for the latitude
+!-
+!- WARNING :
+!- In the case of do_test=FALSE it is for the user to check
+!- that the dimensions of lon lat and lev are correct when passed to
+!- flinopen. This can be done after the call when iim and jjm have
+!- been retrieved from the netCDF file. In F90 this problem will
+!- be solved with an internal assign
+!- IF iim, jjm, llm or ttm are parameters in the calling program and
+!- you use the option do_test=FALSE it will create a segmentation fault
+!-
+!-  OUTPUT
+!-
+!-  ttm       : size of time axis
+!-  itaus     : Time steps within this file
+!-  date0     : Julian date at which itau = 0
+!-  dt        : length of the time steps of the data
+!-  fid       : returned file ID which is later used to read the data
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinopen_zoom2d, flinopen_nozoom
+  END INTERFACE
+!-
+  INTERFACE flinput
+!---------------------------------------------------------------------
+!- The "flinput" routines will put a variable
+!- on the netCDF file created by flincre.
+!- If the sizes of the axis do not match the one of the IDs
+!- then a new axis is created.
+!- That is we loose the possibility of writting hyperslabs of data.
+!-
+!- Again here if iim = jjm = llm = ttm = 0
+!- then a global attribute is added to the file.
+!-
+!- INPUT
+!-
+!- fid      : Identification of the file in which we will write
+!- varname  : Name of variable to be written
+!- iim      : size in x of variable
+!- nlonid   : ID of x axis which could fit for this axis
+!- jjm      : size in y of variable
+!- nlatid   : ID of y axis which could fit for this axis
+!- llm      : size in z of variable
+!- zdimid   : ID of z axis which could fit for this axis
+!- ttm      : size in t of variable
+!- tdimid   : ID of t axis which could fit for this axis
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+    MODULE PROCEDURE flinput_r4d, flinput_r3d, flinput_r2d, &
+                     flinput_r1d, flinput_scal
+  END INTERFACE
+!-
+  INTERFACE flinget
+    MODULE PROCEDURE flinget_r4d, flinget_r3d, flinget_r2d, &
+                     flinget_r1d, flinget_scal, &
+                     flinget_r4d_zoom2d, flinget_r3d_zoom2d, &
+                     flinget_r2d_zoom2d
+  END INTERFACE
+!-
+! This is the data we keep on each file we open
+!-
+  INTEGER, PARAMETER :: nbfile_max = 200
+  INTEGER, SAVE :: nbfiles = 0
+  INTEGER, SAVE :: ncids(nbfile_max), ncnbd(nbfile_max), &
+                   ncfunli(nbfile_max), ncnba(nbfile_max)
+  INTEGER, SAVE :: ncnbva(nbfile_max), ncdims(nbfile_max,4)
+  LOGICAL, SAVE :: ncfileopen(nbfile_max)=.FALSE.
+!-
+  INTEGER, SAVE :: cind_vid, cind_fid, cind_len
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: cindex
+!-
+  INTEGER,DIMENSION(4) :: w_sta, w_len, w_dim
+!-
+CONTAINS
+!-
+!===
+!-
+SUBROUTINE flincre &
+  (filename, iim1, jjm1, lon1, lat1, llm1, lev1, ttm1, itaus, &
+   time0, dt, fid_out, nlonid1, nlatid1, zdimid1, tdimid1)
+!---------------------------------------------------------------------
+!- This is a "low level" subroutine for opening netCDF files wich
+!- contain the major coordinate system of the model.
+!- Other coordinates needed for other variables
+!- will be added as they are needed.
+!-
+!- INPUT
+!-
+!- filename    : Name of the file to be created
+!- iim1, jjm1  : Horizontal size of the grid
+!-               which will be stored in the file
+!- lon1, lat1  : Horizontal grids
+!- llm1        : Size of the vertical grid
+!- lev1        : Vertical grid
+!- ttm1        : Size of time axis
+!- itaus       : time steps on the time axis
+!- time0       : Time in julian days at which itau = 0
+!- dt          : time step in seconds between itaus
+!-               (one step of itau)
+!-
+!- OUTPUT
+!-
+!- fid         : File identification
+!- nlonid1     : Identification of longitudinal axis
+!- nlatid1     : Identification of latitudinal axis
+!- zdimid1     : ID of vertical axis
+!- tdimid1     : ID of time axis
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim1, jjm1, llm1, ttm1
+  REAL :: lon1(iim1,jjm1)
+  REAL :: lat1(iim1,jjm1)
+  REAL :: lev1(llm1)
+  INTEGER :: itaus(ttm1)
+  REAL :: time0
+  REAL :: dt
+  INTEGER :: fid_out, zdimid1, nlonid1, nlatid1, tdimid1
+!-
+! LOCAL
+!-
+  INTEGER :: iret, lll, fid
+  INTEGER :: lonid, latid, levid, timeid
+  INTEGER :: year, month, day
+  REAL :: sec
+  CHARACTER(LEN=250):: name
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name=filename(1:lll)//'.nc'
+  ELSE
+    name=filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_CREATE (name, NF90_CLOBBER, fid)
+!-
+  iret = NF90_DEF_DIM (fid, 'x',     iim1, nlonid1)
+  iret = NF90_DEF_DIM (fid, 'y',     jjm1, nlatid1)
+  iret = NF90_DEF_DIM (fid, 'lev',   llm1, zdimid1)
+  iret = NF90_DEF_DIM (fid, 'tstep', ttm1, tdimid1)
+!-
+! Vertical axis
+!-
+  IF (check) WRITE(*,*) 'flincre Vertical axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'lev', NF90_FLOAT, zdimid1, levid)
+  iret = NF90_PUT_ATT (fid, levid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, levid, 'title',     'levels')
+  iret = NF90_PUT_ATT (fid, levid, 'long_name', 'Sigma Levels')
+!-
+! Time axis
+!-
+  IF (check) WRITE(*,*) 'flincre time axis'
+!-
+  iret = NF90_DEF_VAR (fid, 'tstep', NF90_FLOAT, tdimid1, timeid)
+  iret = NF90_PUT_ATT (fid, timeid, 'units',     '-')
+  iret = NF90_PUT_ATT (fid, timeid, 'title',     'time')
+  iret = NF90_PUT_ATT (fid, timeid, 'long_name', 'time steps')
+!-
+! The longitude
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lon", NF90_FLOAT, &
+                       (/ nlonid1, nlatid1 /), lonid)
+  iret = NF90_PUT_ATT (fid, lonid, 'units', "degrees_east")
+  iret = NF90_PUT_ATT (fid, lonid, 'title', "Longitude")
+  iret = NF90_PUT_ATT (fid, lonid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_min', &
+                       REAL(MINVAL(lon1),KIND=4))
+  iret = NF90_PUT_ATT (fid, lonid, 'valid_max', &
+                       REAL(MAXVAL(lon1),KIND=4))
+!-
+! The Latitude
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude axis'
+!-
+  iret = NF90_DEF_VAR (fid, "nav_lat", NF90_FLOAT, &
+                     (/ nlonid1, nlatid1 /), latid)
+  iret = NF90_PUT_ATT (fid, latid, 'units', "degrees_north")
+  iret = NF90_PUT_ATT (fid, latid, 'title', "Latitude")
+  iret = NF90_PUT_ATT (fid, latid, 'nav_model', &
+                       "Lambert projection of PROMES")
+  iret = NF90_PUT_ATT (fid, latid, 'valid_min', &
+                       REAL(MINVAL(lat1),KIND=4))
+  iret = NF90_PUT_ATT (fid, latid, 'valid_max', &
+                       REAL(MAXVAL(lat1),KIND=4))
+!-
+! The time coordinates
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', &
+                       REAL(dt,KIND=4))
+!-
+  CALL ju2ymds (time0, year, month, day, sec)
+!-
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'year0',  REAL(year,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'month0', REAL(month,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'day0',   REAL(day,KIND=4))
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, 'sec0',   REAL(sec,KIND=4))
+!-
+  iret = NF90_ENDDEF (fid)
+!-
+  IF (check) WRITE(*,*) 'flincre Variable'
+!-
+  iret = NF90_PUT_VAR (fid, levid, lev1(1:llm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Time Variable'
+!-
+  iret = NF90_PUT_VAR (fid, timeid, REAL(itaus(1:ttm1)))
+!-
+  IF (check) WRITE(*,*) 'flincre Longitude'
+!-
+  iret = NF90_PUT_VAR (fid, lonid, lon1(1:iim1,1:jjm1))
+!-
+  IF (check) WRITE(*,*) 'flincre Latitude'
+!-
+  iret = NF90_PUT_VAR (fid, latid, lat1(1:iim1,1:jjm1))
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flincre', &
+     'Too many files. Please increase nbfil_max', &
+     'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = 4
+!-
+  ncdims(nbfiles,1:4) = (/ iim1, jjm1, llm1, ttm1 /)
+!-
+  ncfunli(nbfiles) = -1
+  ncnba(nbfiles)   =  4
+  ncnbva(nbfiles)  =  0
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!---------------------
+END SUBROUTINE flincre
+!-
+!===
+!-
+SUBROUTINE flinopen_zoom2d &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+  iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE (*,*) ' iideb, iilen, jjdeb, jjlen, iim, jjm ', &
+                           iideb, iilen, jjdeb, jjlen, iim, jjm
+  IF (check) WRITE (*,*) ' lon ', lon(1,1), lon(iilen,jjlen)
+  IF (check) WRITE (*,*) ' lat ', lat(1,1), lat(iilen,jjlen)
+!-
+  CALL flinopen_work &
+    (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-----------------------------
+END SUBROUTINE flinopen_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinopen_nozoom &
+  (filename, do_test, iim, jjm, llm, lon, lat, lev, ttm, &
+   itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm
+  REAL :: lon(iim,jjm), lat(iim,jjm), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!---------------------------------------------------------------------
+  CALL flinopen_work &
+    (filename, 1, iim, 1, jjm, do_test, &
+     iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!-------------------------
+END SUBROUTINE flinopen_nozoom
+!-
+!===
+!-
+SUBROUTINE flinopen_work &
+  (filename, iideb, iilen, jjdeb, jjlen, do_test, &
+   iim, jjm, llm, lon, lat, lev, ttm, itaus, date0, dt, fid_out)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  LOGICAL :: do_test
+  INTEGER :: iim, jjm, llm, ttm, iideb, iilen, jjdeb, jjlen
+  REAL :: lon(iilen,jjlen), lat(iilen,jjlen), lev(llm)
+  INTEGER :: itaus(ttm)
+  REAL :: date0, dt
+  INTEGER :: fid_out
+!-
+! LOCAL
+!-
+  REAL, PARAMETER :: eps = 1.e-4
+!-
+  INTEGER :: iret, vid, fid, nbdim, i, iilast, jjlast
+  INTEGER :: gdtt_id, old_id, iv, gdtmaf_id
+  CHARACTER(LEN=250) :: name
+  CHARACTER(LEN=80) :: units, calendar
+  INTEGER :: tmp_iim, tmp_jjm, tmp_llm, tmp_ttm
+  REAL :: x_first, x_last
+  INTEGER :: year, month, day
+  REAL :: r_year, r_month, r_day
+  INTEGER :: year0, month0, day0, hours0, minutes0, seci
+  REAL :: sec, sec0
+  CHARACTER :: strc
+!-
+  REAL,DIMENSION(:),ALLOCATABLE :: vec_tmp
+!-
+  LOGICAL :: open_file
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  iilast = iideb+iilen-1
+  jjlast = jjdeb+jjlen-1
+  IF (check) WRITE (*,*) &
+    ' flinopen_work zoom 2D information '// &
+    ' iideb, iilen, iilast, jjdeb, jjlen, jjlast ', &
+      iideb, iilen, iilast, jjdeb, jjlen, jjlast
+!-
+! 1.0 get all infos on the file
+!-
+! Either the fid_out has not been initialized (0 or very large)
+! then we have to open anyway. Else we only need to open the file
+! if it has not been opened before.
+!-
+  IF ( (fid_out < 1).OR.(fid_out > nbfile_max) ) THEN
+    open_file = .TRUE.
+  ELSE IF (.NOT.ncfileopen(fid_out)) THEN
+    open_file = .TRUE.
+  ELSE
+    open_file = .FALSE.
+  ENDIF
+!-
+  IF (open_file) THEN
+    CALL flininfo (filename,tmp_iim,tmp_jjm,tmp_llm,tmp_ttm,fid_out)
+  ELSE
+!-- The user has already opened the file
+!-- and we trust that he knows the dimensions
+    tmp_iim = iim
+    tmp_jjm = jjm
+    tmp_llm = llm
+    tmp_ttm = ttm
+  ENDIF
+!-
+  IF (check) &
+    WRITE(*,*) 'OUT OF flininfo :',tmp_iim,tmp_jjm,tmp_llm,tmp_ttm
+!-
+  fid = ncids(fid_out)
+!-
+! 2.0 get the sizes and names of the different coordinates
+!     and do a first set of verification.
+!-
+! 2.2 We test the axis if we have to.
+!-
+  IF (check) &
+    WRITE(*,*) 'flininfo 2.2 We test if we have to test : ',do_test
+!-
+  IF (do_test) THEN
+    IF      (iim /= tmp_iim) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in x direction (longitude)',' ')
+    ELSE IF (jjm /= tmp_jjm) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in y direction (latitude)',' ')
+    ELSE IF ( llm /= tmp_llm .AND. llm > 0 ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' does not have the ', &
+        'required dimension in the vertical',' ')
+    ENDIF
+  ELSE
+!---
+!-- 2.3 Else the sizes of the axes are returned to the user
+!---
+    IF (check) WRITE(*,*) 'flinopen 2.3 Else sizes are returned'
+!---
+    iim = tmp_iim
+    jjm = tmp_jjm
+    llm = tmp_llm
+  ENDIF
+!-
+  ttm = tmp_ttm
+!-
+! 3.0 Check if we are realy talking about the same coodinate system
+!     if not then we get the lon, lat and lev variables from the file
+!-
+  IF (check) WRITE(*,*) 'flinopen 3.0 we are realy talking'
+!-
+  IF (do_test) THEN
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) &
+      WRITE(*,*) 'from file lon first and last, modulo 360. ', &
+        x_first, x_last, MODULO(x_first,360.), MODULO(x_last,360.)
+    IF (check) &
+      WRITE(*,*) 'from model lon first and last, modulo 360. ', &
+        lon(1,1),lon(iilen,jjlen), &
+        MODULO(lon(1,1),360.), MODULO(lon(iilen,jjlen),360.)
+    IF (    (ABS( MODULO(x_first,360.) &
+                 -MODULO(lon(1,1),360.)) > eps) &
+        .OR.(ABS( MODULO(x_last,360.) &
+                 -MODULO(lon(iilen ,jjlen),360.)) > eps ) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same longitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    iret = NF90_GET_VAR (fid, vid, x_first, start=(/ iideb, jjdeb /))
+    iret = NF90_GET_VAR (fid, vid, x_last, start=(/ iilast, jjlast /))
+!---
+    IF (check) WRITE(*,*) &
+      'from file lat first and last ',x_first,x_last
+    IF (check) WRITE(*,*) &
+      'from model lat first and last ',lat(1,1),lat(iilen,jjlen)
+!---
+    IF (    (ABS(x_first-lat(1,1)) > eps) &
+        .OR.(ABS(x_last-lat(iilen,jjlen)) > eps) ) THEN
+      CALL histerr (3,'flinopen', &
+        'file '//filename//' and the model do not', &
+        'share the same latitude coordinate', &
+        'Obtained by comparing the first and last values ')
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      iret = NF90_GET_VAR (fid, vid, x_first, start=(/ 1 /))
+      iret = NF90_GET_VAR (fid, vid, x_last, start=(/ llm /))
+!-----
+      IF (check) WRITE(*,*) &
+        'from file lev first and last ',x_first ,x_last
+      IF (check) WRITE(*,*) &
+        'from model lev first and last ',lev(1),lev(llm)
+!-----
+      IF (    (ABS(x_first-lev(1)) > eps) &
+          .OR.(ABS(x_last-lev(llm)) > eps) ) THEN
+        CALL histerr (3,'flinopen', &
+          'file '//filename//' and the model do not', &
+          'share the same vertical coordinate', &
+          'Obtained by comparing the first and last values')
+      ENDIF
+    ENDIF
+!---
+  ELSE
+!---
+!-- 4.0 extracting the coordinates if we do not check
+!---
+    IF (check) WRITE(*,*) 'flinopen 4.0 extracting the coordinates'
+!---
+    CALL flinfindcood (fid_out, 'lon', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lon, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(iilen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ iideb /), count=(/ iilen /))
+      DO i=1,jjlen
+        lon(:,i) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    CALL flinfindcood (fid_out, 'lat', vid, nbdim)
+    IF (nbdim == 2) THEN
+      iret = NF90_GET_VAR (fid, vid, lat, &
+               start=(/ iideb, jjdeb /), count=(/ iilen, jjlen /))
+    ELSE
+      ALLOCATE(vec_tmp(jjlen))
+      iret = NF90_GET_VAR (fid, vid, vec_tmp, &
+               start=(/ jjdeb /), count=(/ jjlen /))
+      DO i=1,iilen
+        lat(i,:) = vec_tmp(:)
+      ENDDO
+      DEALLOCATE(vec_tmp)
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      CALL flinfindcood (fid_out, 'lev', vid, nbdim)
+      IF (nbdim == 1) THEN
+        iret = NF90_GET_VAR (fid, vid, lev, &
+                 start=(/ 1 /), count=(/ llm /))
+      ELSE
+        CALL histerr (3,'flinopen', &
+          'Can not handle vertical coordinates that have more',&
+          'than 1 dimension',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!-
+! 5.0 Get all the details for the time if possible needed
+!-
+  IF (check) WRITE(*,*) 'flinopen 5.0 Get time'
+!-
+  IF (ttm > 0) THEN
+!---
+!-- 5.1 Find the time axis. Prefered method is the 'timestep since'
+!---
+    gdtmaf_id = -1
+    gdtt_id = -1
+    old_id = -1
+    DO iv=1,ncnbva(fid_out)
+      name=''
+      iret = NF90_INQUIRE_VARIABLE (fid, iv, name=name)
+      units=''
+      iret = NF90_GET_ATT (fid, iv, 'units', units)
+      IF (INDEX(units,'seconds since') > 0) gdtmaf_id = iv
+      IF (INDEX(units,'timesteps since') > 0) gdtt_id = iv
+      IF (INDEX(name, 'tstep') > 0) old_id = iv
+    ENDDO
+!---
+    IF (gdtt_id > 0) THEN
+      vid = gdtt_id
+    ELSE IF (gdtmaf_id > 0) THEN
+      vid = gdtmaf_id
+    ELSE IF (old_id > 0) THEN
+      vid = old_id
+    ELSE
+      CALL histerr (3, 'flinopen', 'No time axis found',' ',' ')
+    ENDIF
+!---
+    ALLOCATE(vec_tmp(ttm))
+    iret = NF90_GET_VAR (fid,vid,vec_tmp,start=(/ 1 /),count=(/ ttm /))
+    itaus(1:ttm) = NINT(vec_tmp(1:ttm))
+    DEALLOCATE(vec_tmp)
+!---
+    IF (check) WRITE(*,*) 'flinopen 5.1 Times ',itaus
+!---
+!-- Getting all the details for the time axis
+!---
+!-- Find the calendar
+    calendar = ''
+    iret = NF90_GET_ATT (fid,gdtmaf_id,'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar(calendar)
+    ENDIF
+!--
+    units = ''
+    iret = NF90_GET_ATT (fid,vid,'units',units)
+    IF (gdtt_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtt_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+!-----
+      iret = NF90_GET_ATT (fid, gdtt_id, 'tstep_sec', dt)
+    ELSE IF (gdtmaf_id > 0) THEN
+      units = units(INDEX(units,'since')+6:LEN_TRIM(units))
+      READ (units,'(I4.4,5(a,I2.2))') &
+        year0, strc, month0, strc, day0, &
+               strc, hours0, strc, minutes0, strc, seci
+      sec0 = hours0*3600. + minutes0*60. + seci
+      CALL ymds2ju (year0, month0, day0, sec0, date0)
+!-----
+      IF (check) &
+        WRITE(*,*) 'flinopen 5.1 gdtmaf_id year0 ... date0 ', &
+                   year0, month0, day0, sec0, date0
+    ELSE IF (old_id > 0) THEN
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'delta_tstep_sec', dt)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'day0', r_day)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'sec0', sec)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'year0', r_year)
+      iret = NF90_GET_ATT (fid, NF90_GLOBAL, 'month0', r_month)
+!-----
+      day = INT(r_day)
+      month = INT(r_month)
+      year = INT(r_year)
+!-----
+      CALL ymds2ju (year, month, day, sec, date0)
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinopen 6.0 File opened', date0, dt
+!---------------------------
+END SUBROUTINE flinopen_work
+!-
+!===
+!-
+SUBROUTINE flininfo (filename, iim, jjm, llm, ttm, fid_out)
+!---------------------------------------------------------------------
+!- This subroutine allows to get some information.
+!- It is usualy done within flinopen but the user may want to call
+!- it before in order to allocate the space needed to extract the
+!- data from the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  CHARACTER(LEN=*) :: filename
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, lll
+  INTEGER :: xid, yid, zid, tid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  lll = LEN_TRIM(filename)
+  IF (filename(lll-2:lll) /= '.nc') THEN
+    name = filename(1:lll)//'.nc'
+  ELSE
+    name = filename(1:lll)
+  ENDIF
+!-
+  iret = NF90_OPEN (name, NF90_NOWRITE, fid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL histerr(3, 'flininfo','Could not open file :',TRIM(name),' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                      nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    IF (check) WRITE(*,*) &
+      'flininfo - getting axname',iv,axname,lll
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1) ) THEN
+      xid = iv; iim = lll;
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1) ) THEN
+      yid = iv; jjm = lll;
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1) ) THEN
+      zid = iv; llm = lll;
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1) ) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr (3,'flininfo', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!----------------------
+END SUBROUTINE flininfo
+!-
+!===
+!-
+SUBROUTINE flinput_r1d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r1d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r1d
+!-
+!===
+!-
+SUBROUTINE flinput_r2d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r2d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r2d
+!-
+!===
+!-
+SUBROUTINE flinput_r3d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r3d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r3d
+!-
+!===
+!-
+SUBROUTINE flinput_r4d &
+  (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: fid, ncvarid, ndim, iret
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) &
+     "flinput_r4d : SIZE(var) = ",SIZE(var)
+!-
+  CALL flinput_mat &
+    (fid_in,varname,iim,nlonid,jjm,nlatid,llm,zdimid,ttm,tdimid, &
+     fid,ncvarid,ndim)
+!-
+  iret = NF90_PUT_VAR (fid, ncvarid, var, &
+           start=w_sta(1:ndim), count=w_len(1:ndim))
+!-------------------------
+END SUBROUTINE flinput_r4d
+!-
+!===
+!-
+SUBROUTINE flinput_mat &
+  (fid_in,varname,iim,nlonid,jjm,nlatid, &
+                  llm,zdimid,ttm,tdimid,fid,ncvarid,ndim)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  INTEGER :: fid, ncvarid, ndim
+!-
+! LOCAL
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  w_sta(1:4) = (/      1,      1,  1,  1 /)
+  w_len(1:2) = (/    iim,    jjm /)
+  w_dim(1:2) = (/ nlonid, nlatid /)
+!-
+  IF ( (llm > 0).AND.(ttm > 0) ) THEN
+    ndim = 4
+    w_len(3:4) = (/    llm,    ttm /)
+    w_dim(3:4) = (/ zdimid, tdimid /)
+  ELSE IF (llm > 0) THEN
+    ndim = 3
+    w_dim(3) = zdimid
+    w_len(3) = llm
+  ELSE IF (ttm > 0) THEN
+    ndim = 3
+    w_dim(3) = tdimid
+    w_len(3) = ttm
+  ELSE
+    ndim = 2
+  ENDIF
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_DEF_VAR (fid,varname,NF90_FLOAT,w_dim(1:ndim),ncvarid)
+  iret = NF90_PUT_ATT (fid,ncvarid,'short_name',TRIM(varname))
+  iret = NF90_ENDDEF  (fid)
+!--------------------------
+END  SUBROUTINE flinput_mat
+!-
+!===
+!-
+SUBROUTINE flinput_scal &
+  (fid_in, varname, iim, nlonid, jjm, nlatid, &
+                    llm, zdimid, ttm, tdimid, var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, nlonid, jjm, nlatid, llm, zdimid, ttm, tdimid
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: fid, iret
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_REDEF   (fid)
+  iret = NF90_PUT_ATT (fid, NF90_GLOBAL, varname, REAL(var,KIND=4))
+  iret = NF90_ENDDEF  (fid)
+!---------------------------
+END  SUBROUTINE flinput_scal
+!-
+!===
+!-
+SUBROUTINE flinget_r1d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:)
+!-
+  INTEGER :: jl, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r1d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO ji=1,SIZE(var,1)
+    jl=jl+1
+    var(ji) = buff_tmp(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r1d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r2d
+!-
+!===
+!-
+SUBROUTINE flinget_r2d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:)
+!-
+  INTEGER :: jl, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r2d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jj=1,SIZE(var,2)
+    DO ji=1,SIZE(var,1)
+      jl=jl+1
+      var(ji,jj) = buff_tmp(jl)
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r2d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r3d
+!-
+!===
+!-
+SUBROUTINE flinget_r3d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r3d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jk=1,SIZE(var,3)
+    DO jj=1,SIZE(var,2)
+      DO ji=1,SIZE(var,1)
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r3d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d &
+  (fid_in,varname,iim,jjm,llm,ttm,itau_dep,itau_fin,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,1,iim,1,jjm,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE flinget_r4d
+!-
+!===
+!-
+SUBROUTINE flinget_r4d_zoom2d &
+  (fid_in,varname,iim,jjm,llm,ttm, &
+   itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,var)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm,ttm,itau_dep,itau_fin,iideb,jjdeb,iilen,jjlen
+  REAL :: var(:,:,:,:)
+!-
+  INTEGER :: jl, jk, jj, ji, jm
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: buff_tmp
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : allocate buff_tmp for buff_sz = ",SIZE(var)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ELSE IF (SIZE(var) > SIZE(buff_tmp)) THEN
+    IF (check) WRITE(*,*) &
+      "flinget_r4d_zoom : re-allocate buff_tmp for buff_sz = ",SIZE(var)
+    DEALLOCATE (buff_tmp)
+    ALLOCATE (buff_tmp(SIZE(var)))
+  ENDIF
+!-
+  CALL flinget_mat (fid_in,varname,iim,jjm,llm,ttm, &
+                    itau_dep,itau_fin,iideb,iilen,jjdeb,jjlen,buff_tmp)
+!-
+  jl=0
+  DO jm=1,SIZE(var,4)
+    DO jk=1,SIZE(var,3)
+      DO jj=1,SIZE(var,2)
+        DO ji=1,SIZE(var,1)
+          jl=jl+1
+          var(ji,jj,jk,jm) = buff_tmp(jl)
+        ENDDO
+      ENDDO
+    ENDDO
+  ENDDO
+!--------------------------------
+END SUBROUTINE flinget_r4d_zoom2d
+!-
+!===
+!-
+SUBROUTINE flinget_mat &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, &
+   itau_fin, iideb, iilen, jjdeb, jjlen, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- It is checked that the dimensions of the variable to be read
+!- correspond to what the user requested when he specified
+!- iim, jjm and llm. The only exception which is allowed is
+!- for compressed data where the horizontal grid is not expected
+!- to be iim x jjm.
+!-
+!- If variable is of size zero a global attribute is read.
+!- This global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-            For the moment this is done on indexes
+!-            but it should be in the physical space.
+!-            If there is no time-axis in the file then use a
+!-            itau_fin < itau_dep, this will tell flinget not to
+!-            expect a time-axis in the file.
+!- iideb    : index i for zoom
+!- iilen    : length of zoom
+!- jjdeb    : index j for zoom
+!- jjlen    : length of zoom
+!-
+!- OUTPUT
+!-
+!- var      : array that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm
+  INTEGER :: itau_dep, itau_fin, iideb, iilen, jjdeb, jjlen
+  REAL :: var(:)
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+  INTEGER :: vid, cvid, clen
+  CHARACTER(LEN=70) :: str1
+  CHARACTER(LEN=250) :: att_n, tmp_n
+  CHARACTER(LEN=5) :: axs_l
+  INTEGER :: tmp_i
+  REAL,SAVE :: mis_v=0.
+  REAL :: tmp_r
+  INTEGER :: ndims, x_typ, nb_atts
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dimids
+  INTEGER :: i, nvars, i2d, cnd
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: var_tmp
+  LOGICAL :: uncompress = .FALSE.
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid_in, fid, varname :', fid_in, fid, TRIM(varname)
+    WRITE(*,*) &
+    'flinget_mat : iim, jjm, llm, ttm, itau_dep, itau_fin :', &
+    iim, jjm, llm, ttm, itau_dep, itau_fin
+    WRITE(*,*) &
+    'flinget_mat : iideb, iilen, jjdeb, jjlen :', &
+    iideb, iilen, jjdeb, jjlen
+  ENDIF
+!-
+  uncompress = .FALSE.
+!-
+! 1.0 We get first all the details on this variable from the file
+!-
+  nvars = ncnbva(fid_in)
+!-
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  IF (vid < 0 .OR. iret /= NF90_NOERR) THEN
+    CALL histerr (3,'flinget', &
+      'Variable '//TRIM(varname)//' not found in file',' ',' ')
+  ENDIF
+!-
+  iret = NF90_INQUIRE_VARIABLE (fid, vid, &
+           ndims=ndims, dimids=dimids, nAtts=nb_atts)
+  IF (check) THEN
+    WRITE(*,*) &
+    'flinget_mat : fid, vid :', fid, vid
+    WRITE(*,*) &
+    'flinget_mat : ndims, dimids(1:ndims), nb_atts :', &
+    ndims, dimids(1:ndims), nb_atts
+  ENDIF
+!-
+  w_dim(:) = 0
+  DO i=1,ndims
+    iret  = NF90_INQUIRE_DIMENSION (fid, dimids(i), len=w_dim(i))
+  ENDDO
+  IF (check) WRITE(*,*) &
+    'flinget_mat : w_dim :', w_dim(1:ndims)
+!-
+  mis_v = 0.0; axs_l = ' ';
+!-
+  IF (nb_atts > 0) THEN
+    IF (check) THEN
+      WRITE(*,*) 'flinget_mat : attributes for variable :'
+    ENDIF
+  ENDIF
+  DO i=1,nb_atts
+    iret = NF90_INQ_ATTNAME (fid, vid, i, att_n)
+    iret = NF90_INQUIRE_ATTRIBUTE (fid, vid, att_n, xtype=x_typ)
+    CALL strlowercase (att_n)
+    IF      (    (x_typ == NF90_INT).OR.(x_typ == NF90_SHORT) &
+             .OR.(x_typ == NF90_BYTE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_i)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_i
+      ENDIF
+    ELSE IF ( (x_typ == NF90_FLOAT).OR.(x_typ == NF90_DOUBLE) ) THEN
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_r)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',tmp_r
+      ENDIF
+      IF (index(att_n,'missing_value') > 0) THEN
+        mis_v = tmp_r
+      ENDIF
+    ELSE
+      tmp_n = ''
+      iret = NF90_GET_ATT (fid, vid, att_n, tmp_n)
+      IF (check) THEN
+        WRITE(*,*) '   ',TRIM(att_n),' : ',TRIM(tmp_n)
+      ENDIF
+      IF (index(att_n,'axis') > 0) THEN
+        axs_l = tmp_n
+      ENDIF
+    ENDIF
+  ENDDO
+!?
+!!!!!!!!!! We will need a verification on the type of the variable
+!?
+!-
+! 2.0 The dimensions are analysed to determine what is to be read
+!-
+! 2.1 the longitudes
+!-
+  IF ( w_dim(1) /= iim .OR. w_dim(2) /= jjm) THEN
+!---
+!-- There is a possibility that we have to deal with a compressed axis !
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, dimids(1), &
+             name=tmp_n, len=clen)
+    iret = NF90_INQ_VARID (fid, tmp_n, cvid)
+!---
+    IF (check) WRITE(*,*) &
+      'Dimname, iret , NF90_NOERR : ',TRIM(tmp_n),iret,NF90_NOERR
+!---
+!-- If we have an axis which has the same name
+!-- as the dimension we can see if it is compressed
+!---
+!-- TODO TODO for zoom2d
+!---
+    IF (iret == NF90_NOERR) THEN
+      iret = NF90_GET_ATT (fid, cvid, 'compress', str1)
+!-----
+      IF (iret == NF90_NOERR) THEN
+        iret = NF90_INQUIRE_VARIABLE (fid,cvid,xtype=x_typ,ndims=cnd)
+!-------
+        IF ( cnd /= 1 .AND. x_typ /= NF90_INT) THEN
+          CALL histerr (3,'flinget', &
+            'Variable '//TRIM(tmp_n)//' can not be a compressed axis', &
+            'Either it has too many dimensions'// &
+            ' or it is not of type integer', ' ')
+        ELSE
+!---------
+!-------- Let us see if we already have that index table
+!---------
+          IF (    (cind_len /= clen).OR.(cind_vid /= cvid) &
+              .OR.(cind_fid /= fid) ) THEN
+            IF (ALLOCATED(cindex))   DEALLOCATE(cindex)
+            ALLOCATE(cindex(clen))
+            cind_len = clen
+            cind_vid = cvid
+            cind_fid = fid
+            iret = NF90_GET_VAR (fid, cvid, cindex)
+          ENDIF
+!---------
+!-------- In any case we need to set the slab of data to be read
+!---------
+          uncompress = .TRUE.
+          w_sta(1) = 1
+          w_len(1) = clen
+          i2d = 1
+        ENDIF
+      ELSE
+        str1 = 'The horizontal dimensions of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'is not compressed and does not'// &
+          ' correspond to the requested size',' ')
+      ENDIF
+    ELSE
+      IF (w_dim(1) /= iim) THEN
+        str1 = 'The longitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+      IF (w_dim(2) /= jjm) THEN
+        str1 = 'The latitude dimension of '//varname
+        CALL histerr (3,'flinget',str1, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ENDIF
+    ENDIF
+  ELSE
+    w_sta(1:2) = (/ iideb, jjdeb /)
+    w_len(1:2) = (/ iilen, jjlen /)
+    i2d = 2
+  ENDIF
+!-
+! 2.3 Now the difficult part, the 3rd dimension which can be
+! time or levels.
+!-
+! Priority is given to the time axis if only three axes are present.
+!-
+  IF (ndims > i2d) THEN
+!---
+!-- 2.3.1 We have a vertical axis
+!---
+    IF (llm == 1 .AND. ndims == i2d+2 .OR. llm == w_dim(i2d+1)) THEN
+!-----
+      IF (w_dim(i2d+1) /= llm) THEN
+        CALL histerr (3,'flinget', &
+          'The vertical dimension of '//varname, &
+          'in the file is not equal to the dimension', &
+          'that should be read')
+      ELSE
+        w_sta(i2d+1) = 1
+        IF (llm > 0) THEN
+          w_len(i2d+1) = llm
+        ELSE
+          w_len(i2d+1) = w_sta(i2d+1)
+        ENDIF
+      ENDIF
+!-----
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF      (ndims /= i2d+2) THEN
+          CALL histerr (3,'flinget', &
+            'You attempt to read a time slab', &
+            'but there is no time axis on this variable', varname)
+        ELSE IF ((itau_fin - itau_dep) <= w_dim(i2d+2)) THEN
+          w_sta(i2d+2) = itau_dep
+          w_len(i2d+2) = itau_fin-itau_dep+1
+        ELSE
+          CALL histerr (3,'flinget', &
+            'The time step you try to read is not', &
+            'in the file (1)', varname)
+        ENDIF
+      ELSE IF (ndims == i2d+2 .AND. w_dim(i2d+2) > 1) THEN
+        CALL histerr (3,'flinget', &
+          'There is a time axis in the file but no', &
+          'time step give in the call', varname)
+      ELSE
+        w_sta(i2d+2) = 1
+        w_len(i2d+2) = 1
+      ENDIF
+    ELSE
+!-----
+!---- 2.3.2 We do not have any vertical axis
+!-----
+      IF (ndims == i2d+2) THEN
+        CALL histerr (3,'flinget', &
+          'The file contains 4 dimensions', &
+          'but only 3 are requestes for variable ', varname)
+      ENDIF
+      IF ((itau_fin-itau_dep) >= 0) THEN
+        IF (ndims == i2d+1) THEN
+          IF ((itau_fin-itau_dep) < w_dim(i2d+1) ) THEN
+            w_sta(i2d+1) = itau_dep
+            w_len(i2d+1) = itau_fin-itau_dep+1
+          ELSE
+            CALL histerr (3,'flinget', &
+              'The time step you try to read is not', &
+              'in the file (2)', varname)
+          ENDIF
+        ELSE
+          CALL histerr (3,'flinget', &
+            'From your input you sould have 3 dimensions', &
+            'in the file but there are 4', varname)
+        ENDIF
+      ELSE
+        IF (ndims == i2d+1 .AND. w_dim(i2d+1) > 1) THEN
+          CALL histerr (3,'flinget', &
+            'There is a time axis in the file but no', &
+            'time step given in the call', varname)
+        ELSE
+          w_sta(i2d+1) = 1
+          w_len(i2d+1) = 1
+        ENDIF
+      ENDIF
+    ENDIF
+  ELSE
+!---
+!-- 2.3.3 We do not have any vertical axis
+!---
+    w_sta(i2d+1:i2d+2) = (/ 0, 0 /)
+    w_len(i2d+1:i2d+2) = (/ 0, 0 /)
+  ENDIF
+!-
+! 3.0 Reading the data
+!-
+  IF (check) WRITE(*,*) &
+    'flinget_mat 3.0 : ', uncompress, w_sta, w_len
+!---
+  IF (uncompress) THEN
+!---
+    IF (ALLOCATED(var_tmp)) THEN
+      IF (SIZE(var_tmp) < clen) THEN
+        DEALLOCATE(var_tmp)
+        ALLOCATE(var_tmp(clen))
+      ENDIF
+    ELSE
+      ALLOCATE(var_tmp(clen))
+    ENDIF
+!---
+    iret = NF90_GET_VAR (fid, vid, var_tmp, &
+             start=w_sta(:), count=w_len(:))
+!---
+    var(:) = mis_v
+    var(cindex(:)) = var_tmp(:)
+!---
+  ELSE
+    iret = NF90_GET_VAR (fid, vid, var, &
+             start=w_sta(:), count=w_len(:))
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'flinget_mat 3.1 : ',NF90_STRERROR (iret)
+!--------------------------
+END  SUBROUTINE flinget_mat
+!-
+!===
+!-
+SUBROUTINE flinget_scal &
+  (fid_in, varname, iim, jjm, llm, ttm, itau_dep, itau_fin, var)
+!---------------------------------------------------------------------
+!- This subroutine will read the variable named varname from
+!- the file previously opened by flinopen and identified by fid
+!-
+!- If variable is of size zero a global attribute is read. This
+!- global attribute will be of type real
+!-
+!- INPUT
+!-
+!- fid      : File ID returned by flinopen
+!- varname  : Name of the variable to be read from the file
+!- iim      : | These three variables give the size of the variables
+!- jjm      : | to be read. It will be verified that the variables
+!- llm      : | fits in there.
+!- ttm      : |
+!- itau_dep : Time step at which we will start to read
+!- itau_fin : Time step until which we are going to read
+!-           For the moment this is done on indeces but it should be
+!-           in the physical space
+!-           If there is no time-axis in the file then use a
+!-           itau_fin < itau_dep, this will tell flinget not to
+!-           expect a time-axis in the file.
+!-
+!- OUTPUT
+!-
+!- var      : scalar that will contain the data
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim, jjm, llm, ttm, itau_dep, itau_fin
+  REAL :: var
+!-
+! LOCAL
+!-
+  INTEGER :: iret, fid
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) THEN
+    WRITE (*,*) 'flinget_scal in file with id ',fid_in
+  ENDIF
+!-
+  fid = ncids(fid_in)
+!-
+! 1.0 Reading a global attribute
+!-
+  iret = NF90_GET_ATT (fid, NF90_GLOBAL, varname, var)
+!---------------------------
+END  SUBROUTINE flinget_scal
+!-
+!===
+!-
+SUBROUTINE flinfindcood (fid_in, axtype, vid, ndim)
+!---------------------------------------------------------------------
+!- This subroutine explores the file in order to find
+!- the coordinate according to a number of rules
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: fid_in, vid, ndim
+  CHARACTER(LEN=3) :: axtype
+!-
+! LOCAL
+!-
+  INTEGER :: iv, iret, dimnb
+  CHARACTER(LEN=40) :: dimname, dimuni1, dimuni2, dimuni3
+  CHARACTER(LEN=80) :: str1
+  LOGICAL :: found_rule = .FALSE.
+!---------------------------------------------------------------------
+  vid = -1
+!-
+! Make sure all strings are invalid
+!-
+  dimname = '?-?'
+  dimuni1 = '?-?'
+  dimuni2 = '?-?'
+  dimuni3 = '?-?'
+!-
+! First rule : we look for the correct units
+! lon : east
+! lat : north
+! We make an exact check as it would be too easy to mistake
+! some units by just comparing the substrings.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimuni1 = 'degree_e'
+    dimuni2 = 'degrees_e'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimuni1 = 'degree_n'
+    dimuni2 = 'degrees_n'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimuni1 = 'm'
+    dimuni2 = 'km'
+    dimuni3 = 'hpa'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1 = ''
+      iret = NF90_GET_ATT (ncids(fid_in), iv, 'units', str1)
+      IF (iret == NF90_NOERR) THEN
+        CALL strlowercase (str1)
+        IF (    (INDEX(str1, TRIM(dimuni1)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni2)) == 1) &
+            .OR.(INDEX(str1, TRIM(dimuni3)) == 1) ) THEN
+          vid = iv
+          iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, ndims=ndim)
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Second rule : we find specific names :
+! lon : nav_lon
+! lat : nav_lat
+! Here we can check if we find the substring as the
+! names are more specific.
+!-
+  SELECTCASE(axtype)
+  CASE ('lon')
+    dimname = 'nav_lon lon longitude'
+    found_rule = .TRUE.
+  CASE('lat')
+    dimname = 'nav_lat lat latitude'
+    found_rule = .TRUE.
+  CASE('lev')
+    dimname = 'plev level depth deptht'
+    found_rule = .TRUE.
+  CASE DEFAULT
+    found_rule = .FALSE.
+  END SELECT
+!-
+  IF (found_rule) THEN
+    iv = 0
+    DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+      iv = iv+1
+      str1=''
+      iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                    name=str1, ndims=ndim)
+      IF (INDEX(dimname,TRIM(str1)) >= 1) THEN
+        vid = iv
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+! Third rule : we find a variable with the same name as the dimension
+! lon = 1
+! lat = 2
+! lev = 3
+!-
+  IF (vid < 0) THEN
+    SELECTCASE(axtype)
+    CASE ('lon')
+      dimnb = 1
+      found_rule = .TRUE.
+    CASE('lat')
+      dimnb = 2
+      found_rule = .TRUE.
+    CASE('lev')
+      dimnb = 3
+      found_rule = .TRUE.
+    CASE DEFAULT
+      found_rule = .FALSE.
+    END SELECT
+!---
+    IF (found_rule) THEN
+      iret = NF90_INQUIRE_DIMENSION (ncids(fid_in), dimnb, name=dimname)
+      iv = 0
+      DO WHILE ( (vid < 0).AND.(iv < ncnbva(fid_in)) )
+        iv = iv+1
+        str1=''
+        iret = NF90_INQUIRE_VARIABLE (ncids(fid_in), iv, &
+                                      name=str1, ndims=ndim)
+        IF (INDEX(dimname,TRIM(str1)) == 1) THEN
+          vid = iv
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Stop the program if no coordinate was found
+!-
+  IF (vid < 0) THEN
+    CALL histerr (3,'flinfindcood', &
+           'No coordinate axis was found in the file', &
+           'The data in this file can not be used', axtype)
+  ENDIF
+!--------------------------
+END SUBROUTINE flinfindcood
+!-
+!===
+!-
+SUBROUTINE flinclo (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+!-
+  INTEGER :: iret
+!---------------------------------------------------------------------
+  iret = NF90_CLOSE (ncids(fid_in))
+  ncfileopen(fid_in) = .FALSE.
+!---------------------
+END SUBROUTINE flinclo
+!-
+!===
+!-
+SUBROUTINE flinquery_var(fid_in, varname, exists)
+!---------------------------------------------------------------------
+!- Queries the existance of a variable in the file.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid_in
+  CHARACTER(LEN=*) varname
+  LOGICAL :: exists
+!-
+  INTEGER :: iret, fid, vid
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+  vid = -1
+  iret = NF90_INQ_VARID (fid, varname, vid)
+!-
+  exists = ( (vid >= 0).AND.(iret == NF90_NOERR) )
+!---------------------------
+END SUBROUTINE flinquery_var
+!-
+!===
+!-
+SUBROUTINE flininspect (fid_in)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! fid : File id to inspect
+!-
+  INTEGER :: fid_in
+!-
+!- LOCAL
+!-
+  INTEGER :: iim, jjm, llm, ttm, fid_out
+  INTEGER :: iret, fid, ndims, nvars, nb_atts, id_unlim
+  INTEGER :: iv, in, lll
+  INTEGER :: xid, yid, zid, tid
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
+  CHARACTER(LEN=80) :: name
+  CHARACTER(LEN=30) :: axname
+!---------------------------------------------------------------------
+  fid = ncids(fid_in)
+!-
+  iret = NF90_INQUIRE (fid, nDimensions=ndims, nVariables=nvars, &
+                       nAttributes=nb_atts, unlimitedDimId=id_unlim)
+!-
+  WRITE (*,*) 'IOIPSL ID                   : ',fid_in
+  WRITE (*,*) 'NetCDF ID                   : ',fid
+  WRITE (*,*) 'Number of dimensions        : ',ndims
+  WRITE (*,*) 'Number of variables         : ',nvars
+  WRITE (*,*) 'Number of global attributes : ',nb_atts
+  WRITE (*,*) 'ID unlimited                : ',id_unlim
+!-
+  xid = -1; iim = 0;
+  yid = -1; jjm = 0;
+  zid = -1; llm = 0;
+  tid = -1; ttm = 0;
+!-
+  DO iv=1,ndims
+!---
+    iret = NF90_INQUIRE_DIMENSION (fid, iv, name=axname, len=lll)
+    CALL strlowercase (axname)
+    axname = ADJUSTL(axname)
+!---
+    WRITE (*,*) 'Dimension number : ',iv
+    WRITE (*,*) 'Dimension name   : ',TRIM(axname)
+!---
+    IF      (    (INDEX(axname,'x') == 1) &
+             .OR.(INDEX(axname,'lon') == 1)) THEN
+      xid = iv; iim = lll;
+      WRITE (*,*) 'Dimension X size   : ',iim
+    ELSE IF (    (INDEX(axname,'y') == 1) &
+             .OR.(INDEX(axname,'lat') == 1)) THEN
+      yid = iv; jjm = lll;
+      WRITE (*,*) 'Dimension Y size   : ',jjm
+    ELSE IF (    (INDEX(axname,'lev') == 1) &
+             .OR.(INDEX(axname,'plev') == 1) &
+             .OR.(INDEX(axname,'z') == 1) &
+             .OR.(INDEX(axname,'depth') == 1)) THEN
+      zid = iv; llm = lll;
+      WRITE (*,*) 'Dimension Z size   : ',llm
+    ELSE IF (    (INDEX(axname,'tstep') == 1) &
+             .OR.(INDEX(axname,'time_counter') == 1)) THEN
+!---- For the time we certainly need to allow for other names
+      tid = iv; ttm = lll;
+    ELSE IF (ndims == 1) THEN
+!---- Nothing was found and ndims=1 then we have a vector of data
+      xid = 1; iim = lll;
+    ENDIF
+!---
+  ENDDO
+!-
+! Keep all this information
+!-
+  nbfiles = nbfiles+1
+!-
+  IF (nbfiles > nbfile_max) THEN
+    CALL histerr(3,'flininspect', &
+      'Too many files. Please increase nbfil_max', &
+      'in program flincom.F90.',' ')
+  ENDIF
+!-
+  ncids(nbfiles) = fid
+  ncnbd(nbfiles) = ndims
+!-
+  ncdims(nbfiles,1:4) = (/ iim, jjm, llm, ttm /)
+!-
+  ncfunli(nbfiles) = id_unlim
+  ncnba(nbfiles)   = nb_atts
+  ncnbva(nbfiles)  = nvars
+  ncfileopen(nbfiles) = .TRUE.
+!-
+  fid_out = nbfiles
+!-
+  DO in=1,nvars
+    iret = NF90_INQUIRE_VARIABLE (fid, in, &
+             name=name, ndims=ndims, dimids=idimid, nAtts=nb_atts)
+    WRITE (*,*) 'Variable number  ------------ > ', in
+    WRITE (*,*) 'Variable name        : ', TRIM(name)
+    WRITE (*,*) 'Number of dimensions : ', ndims
+    WRITE (*,*) 'Dimensions ID''s     : ', idimid(1:ndims)
+    WRITE (*,*) 'Number of attributes : ', nb_atts
+  ENDDO
+!-------------------------
+END SUBROUTINE flininspect
+!-
+!===
+!-
+END MODULE flincom
Index: vendors/IOIPSL/src/fliocom.f90
===================================================================
--- vendors/IOIPSL/src/fliocom.f90	(revision 9621)
+++ vendors/IOIPSL/src/fliocom.f90	(revision 9621)
@@ -0,0 +1,5173 @@
+MODULE fliocom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE netcdf
+!-
+USE defprec
+USE calendar,  ONLY : lock_calendar,ioget_calendar, &
+ &                    ioconf_calendar,ju2ymds,ymds2ju
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop,  ONLY : strlowercase,str_xfw
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: &
+ &  fliocrfd, fliopstc, fliodefv, flioputv, flioputa, &
+ &  flioopfd, flioinqf, flioinqn, fliogstc, &
+ &  flioinqv, fliogetv, flioinqa, fliogeta, &
+ &  fliorenv, fliorena, fliodela, fliocpya, &
+ &  flioqstc, fliosync, flioclo,  fliodmpf, &
+ &  flio_dom_set,    flio_dom_unset, &
+ &  flio_dom_defset, flio_dom_defunset, flio_dom_definq, &
+ &  flio_dom_file,   flio_dom_att
+!-
+!!--------------------------------------------------------------------
+!! The following PUBLIC parameters (with "flio_" prefix)
+!! are used in the module "fliocom" :
+!!
+!! flio_max_files     : maximum number of simultaneously opened files
+!! flio_max_dims      : maximum number of dimensions for a file
+!! flio_max_var_dims  : maximum number of dimensions for a variable
+!!
+!! FLIO_DOM_NONE    : "named constant" for no_domain identifier
+!! FLIO_DOM_DEFAULT : "named constant" for default_domain identifier
+!!
+!! flio_i  : standard INTEGER external type
+!! flio_r  : standard REAL external type
+!! flio_c  : CHARACTER external type
+!! flio_i1 : INTEGER*1 external type
+!! flio_i2 : INTEGER*2 external type
+!! flio_i4 : INTEGER*4 external type
+!! flio_r4 : REAL*4 external type
+!! flio_r8 : REAL*8 external type
+!!--------------------------------------------------------------------
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  flio_max_files=100, flio_max_dims=10, flio_max_var_dims=5
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  flio_i = -1,        flio_r = -2,        flio_c =nf90_char, &
+ &  flio_i1=nf90_int1,  flio_i2=nf90_int2,  flio_i4=nf90_int4, &
+ &  flio_r4=nf90_real4, flio_r8=nf90_real8
+!-
+  INTEGER,PARAMETER,PUBLIC :: FLIO_DOM_NONE    =-1
+  INTEGER,PARAMETER,PUBLIC :: FLIO_DOM_DEFAULT = 0
+!-
+!!--------------------------------------------------------------------
+!! The "fliocrfd" routine creates a model file
+!! which contains the dimensions needed.
+!!
+!! SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n)
+!!
+!! INPUT
+!!
+!! (C) f_n      : Name of the file to be created
+!! (C) f_d_n(:) : Array of (max nb_fd_mx) names of the dimensions
+!! (I) f_d_l(:) : Array of (max nb_fd_mx) lengths of the dimensions
+!!                For an unlimited dimension, enter a length of -1.
+!!                Actually, only one unlimited dimension is supported.
+!!
+!! OUTPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional INPUT arguments
+!!
+!! (I) id_dom : Identifier of a domain defined by calling
+!!              "flio_dom_set". If this argument is present,
+!!              and not equal to FLIO_DOM_NONE, it will be
+!!              appended to the file name and
+!!              the attributes describing the related DOMAIN
+!!              will be put in the created file.
+!!              This argument can be equal to FLIO_DOM_DEFAULT
+!!              (see "flio_dom_defset").
+!! (C) mode   : String of (case insensitive) blank-separated words
+!!              defining the mode used to create the file.
+!!              Supported keywords : REPLACE, 32, 64
+!!              If this argument is present with the keyword "REPLACE",
+!!              the file will be created in mode "CLOBBER",
+!!              else the file will be created in mode "NOCLOBBER".
+!!              "32/64" defines the offset mode.
+!!              The default offset mode is 64 bits.
+!!              Keywords "NETCDF4" and "CLASSIC" are reserved
+!!              for future use.
+!!
+!! Optional OUTPUT arguments
+!!
+!! (C) c_f_n : Name of the created file.
+!!             This name can be different of "f_n",
+!!             if a suffix is added to the original name
+!!             (".nc" or "DOMAIN_identifier.nc").
+!!             The length of "c_f_n" must be sufficient
+!!             to receive the created file name.
+!!
+!!- NOTES
+!!
+!! The names used to identify the spatio-temporal dimensions
+!! (dimension associated to a coordinate variable)
+!! are the following :
+!!
+!!  Axis       Names
+!!
+!!    x        'x[...]'  'lon[...]'
+!!    y        'y[...]'  'lat[...]'
+!!    z        'z[...]'  'lev[...]'  'plev[...]'   'depth[...]'
+!!    t        't'       'time'      'tstep[...]'  'time_counter[...]'
+!!
+!! Please, apply these rules so that coordinates are
+!! correctly defined.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliopstc" routine defines the major coordinates system
+!! (spatio-temporal axis) of the model file (created by fliocrfd).
+!!
+!! SUBROUTINE fliopstc &
+!! & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+!! &      t_axis,t_init,t_step,t_calendar)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional INPUT arguments
+!!
+!! (R) x_axis(:)      : longitudinal grids
+!! (R) x_axis_2d(:,:) : longitudinal grids
+!! (R) y_axis(:)      : latitudinal grids
+!! (R) y_axis_2d(:,:) : latitudinal grids
+!! (R) z_axis(:)      : vertical grid
+!! (I) t_axis(:)      : timesteps on the time axis
+!! (R) t_init         : date in julian days at the beginning
+!! (R) t_step         : timestep in seconds between t_axis steps
+!! (C) t_calendar     : calendar
+!!
+!! [x/y]_axis and [x/y]_axis_2d are mutually exclusive.
+!!
+!!- NOTES
+!!
+!! The variables corresponding to the spatio-temporal coordinates
+!! are created according to the following characteristics :
+!!
+!!- Longitude axis     x_axis / x_axis_2d
+!!   Variable name     'lon'  / 'nav_lon'
+!!   Attributes        Values
+!!   'axis'            "X"
+!!   'standard_name'   "longitude"
+!!   'units'           "degrees_east"
+!!   'valid_min'       MINVAL(x_axis/x_axis_2d)
+!!   'valid_max'       MAXVAL(x_axis/x_axis_2d)
+!!
+!!- Latitude axis      y_axis / y_axis_2d
+!!   Variable name     'lat'  / 'nav_lat'
+!!   Attributes        Values
+!!   'axis'            "Y"
+!!   'standard_name'   "latitude"
+!!   'units'           "degrees_north"
+!!   'valid_min'       MINVAL(y_axis/y_axis_2d)
+!!   'valid_max'       MAXVAL(y_axis/y_axis_2d)
+!!
+!!- Vertical axis      z_axis
+!!   Variable name     'lev'
+!!   Attributes        Values
+!!   'axis'            "Z"
+!!   'standard_name'   "model_level_number"
+!!   'units'           "sigma_level"
+!!   'long_name'       "Sigma Levels"
+!!   'valid_min'       MINVAL(z_axis)
+!!   'valid_max'       MAXVAL(z_axis)
+!!
+!!- Time axis          t_axis
+!!   Variable name     'time'
+!!   Attributes        Values
+!!   'axis'            "T"
+!!   'standard_name'   "time"
+!!   'long_name'       "time steps"
+!!  ['calendar'        user/default valued]
+!!   'units'           calculated
+!!
+!! If you are not satisfied, it is possible
+!! to rename variables ("fliorenv")
+!! or overload the values of attributes ("flioputa").
+!! Be careful : the new values you use must allow to read variables
+!! as coordinates.
+!!
+!! The dimensions associated to the coordinates variables
+!! are searched according to their names (see "fliocrfd")
+!!--------------------------------------------------------------------
+!-
+INTERFACE fliodefv
+!!--------------------------------------------------------------------
+!! The "fliodefv" routines define a variable in a model file.
+!!
+!! SUBROUTINE fliodefv &
+!! & (f_i,v_n,[v_d],v_t, &
+!! &  axis,standard_name,long_name,units, &
+!! &  valid_min,valid_max,fillvalue)
+!!
+!! INPUT
+!!
+!! (I)  f_i  : Model file identifier
+!! (C)  v_n  : Name of variable to be defined
+!! (I) [v_d] :
+!!             "not present"
+!!                --> scalar variable
+!!             "array of one or several integers containing
+!!              the identifiers of the dimensions of the variable
+!!              (in the order specified to "fliocrfd"
+!!               or obtained from "flioopfd")"
+!!                --> multidimensioned variable
+!!
+!! Optional INPUT arguments
+!!
+!! (I) v_t : External type of the variable
+!!           "present"     --> see flio_..
+!!           "not present" --> type of standard real
+!! (C) axis,standard_name,long_name,units : Attributes
+!!     (axis should be used only for coordinates)
+!! (R) valid_min,valid_max,fillvalue : Attributes
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE &
+ &  fliodv_r0d,fliodv_rnd
+END INTERFACE
+!-
+INTERFACE flioputv
+!!--------------------------------------------------------------------
+!! The "flioputv" routines put a variable (defined by fliodefv)
+!! in a model file.
+!!
+!! SUBROUTINE flioputv (f_i,v_n,v_v,start,count)
+!!
+!! INPUT
+!!
+!! (I) f_i    : model file identifier
+!! (C) v_n    : name of the variable to be written
+!! (R/I) v_v  : scalar or array (up to flio_max_var_dims dimensions)
+!!              containing the (standard) real/integer values
+!!
+!! Optional INPUT arguments
+!!
+!! (I) start(:) : array of integers specifying the index
+!!                where the first data value will be written
+!! (I) count(:) : array of integers specifying the number of
+!!                indices that will be written along each dimension
+!!                (not present if v_v is a scalar)
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+  MODULE PROCEDURE &
+ & fliopv_i40,fliopv_i41,fliopv_i42,fliopv_i43,fliopv_i44,fliopv_i45, &
+ & fliopv_i20,fliopv_i21,fliopv_i22,fliopv_i23,fliopv_i24,fliopv_i25, &
+!& fliopv_i10,fliopv_i11,fliopv_i12,fliopv_i13,fliopv_i14,fliopv_i15, &
+ & fliopv_r40,fliopv_r41,fliopv_r42,fliopv_r43,fliopv_r44,fliopv_r45, &
+ & fliopv_r80,fliopv_r81,fliopv_r82,fliopv_r83,fliopv_r84,fliopv_r85
+END INTERFACE
+!-
+INTERFACE flioputa
+!!--------------------------------------------------------------------
+!! The "flioputa" routines put a value for an attribute
+!! in a model file.
+!! If this attribute does not exist, it will be created.
+!!
+!! SUBROUTINE flioputa (f_i,v_n,a_n,a_v)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of variable to which the attribute is assigned.
+!!            If this name is "?", the attribute will be global.
+!! (C) a_n  : Name of the attribute to be defined.
+!! ( ) a_v  : scalar or array of real (kind 4 or 8) or integer values,
+!!            or character string
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE &
+ &  fliopa_r4_0d,fliopa_r4_1d,fliopa_r8_0d,fliopa_r8_1d, &
+ &  fliopa_i4_0d,fliopa_i4_1d,fliopa_tx_0d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "flioopfd" routine opens an existing model file,
+!! and returns the dimensions used in the file and a file identifier.
+!! This information can be used to allocate the space needed
+!! to extract the data from the file.
+!!
+!! SUBROUTINE flioopfd (f_n,f_i,mode,nb_dim,nb_var,nb_gat)
+!!
+!! INPUT
+!!
+!! (C) f_n     : Name of the file to be opened
+!!
+!! OUTPUT
+!!
+!! (I) f_i      : Model file identifier
+!!
+!! Optional INPUT arguments
+!!
+!! (C) mode : Access mode to the file.
+!!            If this argument is present with the value "WRITE",
+!!            the file will be accessed in mode "READ-WRITE",
+!!            else the file will be accessed in mode "READ-ONLY".
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) nb_dim : number of dimensions
+!! (I) nb_var : number of variables
+!! (I) nb_gat : number of global attributes
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqf" routine returns information
+!! about an opened model file given its identifier.
+!!
+!! SUBROUTINE flioinqf &
+!! & (f_i,nb_dim,nb_var,nb_gat,id_uld,id_dim,ln_dim)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) nb_dim    : number of dimensions
+!! (I) nb_var    : number of variables
+!! (I) nb_gat    : number of global attributes
+!! (I) id_uld    : identifier of the unlimited dimension (0 if none)
+!! (I) id_dim(:) : identifiers of the dimensions
+!! (I) ln_dim(:) : lengths of the dimensions
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqn" routine returns the names
+!! of the entities encountered in an opened model file.
+!!
+!! SUBROUTINE flioinqn &
+!! & (f_i,cn_dim,cn_var,cn_gat,cn_uld, &
+!! &  id_start,id_count,iv_start,iv_count,ia_start,ia_count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional OUTPUT arguments
+!!
+!! (C) cn_dim(:) : names of dimensions
+!! (C) cn_var(:) : names of variables
+!! (C) cn_gat(:) : names of global attributes
+!! (C) cn_uld    : names of the unlimited dimension
+!!
+!! Optional INPUT arguments
+!!
+!! (I) id_start,id_count,iv_start,iv_count,ia_start,ia_count
+!!
+!!  The prefix ( id       / iv      / ia              ) specifies
+!!         the (dimensions/variables/global attributes) entities
+!!
+!!  The suffix "start" specify the index from which
+!!  the first name will be retrieved (1 by default)
+!!
+!!  The suffix "count" specifies the number of names to be retrieved
+!!  (all by default)
+!!
+!!  If a requested entity is not available, a "?" will be returned.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliogstc" routine extracts the major coordinates system
+!! (spatio-temporal axis) of the model file (opened by flioopfd).
+!!
+!! SUBROUTINE fliogstc &
+!! & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+!! &      t_axis,t_init,t_step,t_calendar, &
+!! &      x_start,x_count,y_start,y_count, &
+!! &      z_start,z_count,t_start,t_count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!!
+!! Optional OUTPUT arguments
+!!
+!! (R) x_axis(:)      : longitudinal grids
+!! (R) x_axis_2d(:,:) : longitudinal grids
+!! (R) y_axis(:)      : latitudinal grids
+!! (R) y_axis_2d(:,:) : latitudinal grids
+!! (R) z_axis(:)      : vertical grid
+!! (I) t_axis(:)      : timesteps on the time axis
+!! (R) t_init         : date in julian days at the beginning
+!! (R) t_step         : timestep in seconds between t_axis steps
+!! (C) t_calendar     : calendar attribute
+!!                      (the value is "not found" if the attribute
+!!                       is not present in the model file)
+!!
+!! [x/y]_axis and [x/y]_axis_2d are mutually exclusive.
+!!
+!! Optional INPUT arguments
+!!
+!! (I) x_start,x_count,y_start,y_count,z_start,z_count,t_start,t_count
+!!
+!!  The prefix (x/y/z/t) specifies the concerned direction.
+!!
+!!  The suffix "start" specify the index from which
+!!  the first data value will be read (1 by default)
+!!
+!!  The suffix "count" specifies the number of values to be read
+!!  (all by default)
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqv" routine returns information about a model
+!! variable given its name.
+!! This information can be used to allocate the space needed
+!! to extract the variable from the file.
+!!
+!! SUBROUTINE flioinqv &
+!! & (f_i,v_n,l_ex,nb_dims,len_dims,id_dims, &
+!! &  nb_atts,cn_atts,ia_start,ia_count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (L) l_ex  : Existence of the variable
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) v_t          : External type of the variable (see flio_..)
+!! (I) nb_dims      : number of dimensions of the variable
+!! (I) len_dims(:)  : list of dimension lengths of the variable
+!! (I) id_dims(:)   : list of dimension identifiers of the variable
+!! (I) nb_atts      : number of attributes of the variable
+!! (C) cn_atts(:)   : names of the attributes
+!!
+!! Optional INPUT arguments
+!!
+!! (I) ia_start : index of the first attribute whose the name
+!!                will be retrieved (1 by default)
+!! (I) ia_count : number of names to be retrieved (all by default)
+!!
+!!  If a requested entity is not available, a "?" will be returned.
+!!--------------------------------------------------------------------
+!-
+INTERFACE fliogetv
+!!--------------------------------------------------------------------
+!! The "fliogetv" routines get a variable from a model file.
+!!
+!! SUBROUTINE fliogetv (f_i,v_n,v_v,start,count)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of the variable to be read
+!!
+!! OUTPUT
+!!
+!! (R/I) v_v  : scalar or array (up to flio_max_var_dims dimensions)
+!!              that will contain the (standard) real/integer values
+!!
+!! Optional INPUT arguments
+!!
+!! (I) start(:) : array of integers specifying the index
+!!                from which the first data value will be read
+!! (I) count(:) : array of integers specifying the number of
+!!                indices that will be read along each dimension
+!!                (not present if v_v is a scalar)
+!!--------------------------------------------------------------------
+!?INTEGERS of KIND 1 are not supported on all computers
+  MODULE PROCEDURE &
+ & fliogv_i40,fliogv_i41,fliogv_i42,fliogv_i43,fliogv_i44,fliogv_i45, &
+ & fliogv_i20,fliogv_i21,fliogv_i22,fliogv_i23,fliogv_i24,fliogv_i25, &
+!& fliogv_i10,fliogv_i11,fliogv_i12,fliogv_i13,fliogv_i14,fliogv_i15, &
+ & fliogv_r40,fliogv_r41,fliogv_r42,fliogv_r43,fliogv_r44,fliogv_r45, &
+ & fliogv_r80,fliogv_r81,fliogv_r82,fliogv_r83,fliogv_r84,fliogv_r85
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "flioinqa" routine returns information about an
+!! attribute of a variable given their names, in a model file.
+!! Information about a variable includes its existence,
+!! and the number of values currently stored in the attribute.
+!! For a string-valued attribute, this is the number of
+!! characters in the string.
+!! This information can be used to allocate the space needed
+!! to extract the attribute from the file.
+!!
+!! SUBROUTINE flioinqa (f_i,v_n,a_n,l_ex,a_t,a_l)
+!!
+!! INPUT
+!!
+!! (I) f_i : Model file identifier
+!! (C) v_n : Name of variable to which the attribute is assigned.
+!!           This name is "?" for a global attribute.
+!! (C) a_n : Name of the concerned attribute.
+!!
+!! OUTPUT
+!!
+!! (L) l_ex : existence of the variable
+!!
+!! Optional OUTPUT arguments
+!!
+!! (I) a_t : external type of the attribute
+!! (I) a_l : number of values of the attribute
+!!--------------------------------------------------------------------
+!-
+INTERFACE fliogeta
+!!--------------------------------------------------------------------
+!! The "fliogeta" routines get a value for an attribute
+!! in a model file.
+!!
+!! SUBROUTINE fliogeta (f_i,v_n,a_n,a_v)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of variable to which the attribute is assigned.
+!!            This name is "?" for a global attribute.
+!! (C) a_n  : Name of the attribute to be retrieved.
+!! ( ) a_v  : scalar or array of real (kind 4 or 8) or integer values,
+!!            or character string
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE &
+ &  flioga_r4_0d,flioga_r4_1d,flioga_r8_0d,flioga_r8_1d, &
+ &  flioga_i4_0d,flioga_i4_1d,flioga_tx_0d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "fliorenv" routine renames a variable, in a model file.
+!!
+!! SUBROUTINE fliorenv (f_i,v_o_n,v_n_n)
+!!
+!! INPUT
+!!
+!! (I) f_i    : Model file identifier
+!! (C) v_o_n  : Old name of the variable
+!! (C) v_n_n  : New name of the variable
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliorena" routine renames an attribute
+!! of a variable, in a model file.
+!!
+!! SUBROUTINE fliorena (f_i,v_n,a_o_n,a_n_n)
+!!
+!! INPUT
+!!
+!! (I) f_i    : Model file identifier
+!! (C) v_n    : Name of variable to which the attribute is assigned.
+!!              This name is "?" for a global attribute.
+!! (C) a_o_n  : Old name of the concerned attribute.
+!! (C) a_n_n  : New name of the concerned attribute.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliodela" routine deletes an attribute in a model file.
+!!
+!! SUBROUTINE fliodela (f_i,v_n,a_n)
+!!
+!! INPUT
+!!
+!! (I) f_i  : Model file identifier
+!! (C) v_n  : Name of variable to which the attribute is assigned.
+!!            This name is "?" for a global attribute.
+!! (C) a_n  : Name of the concerned attribute.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliocpya" routine copies an attribute
+!! from one open model file to another.
+!! It can also be used to copy an attribute from
+!! one variable to another within the same model file.
+!!
+!! SUBROUTINE fliocpya (f_i_i,v_n_i,a_n,f_i_o,v_n_o)
+!!
+!! INPUT
+!!
+!! (I) f_i_i : Identifier of the input  model file
+!! (C) v_n_i : Name of the input variable
+!!             This name is "?" for a global attribute.
+!! (C) a_n   : Name of the concerned attribute.
+!! (I) f_i_o : Identifier of the output model file
+!!             It can be the same as the input identifier.
+!! (C) v_n_o : Name of the output variable
+!!             This name is "?" for a global attribute.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioqstc" routine search for a spatio-temporal coordinate
+!! in a model file and returns its name.
+!!
+!! SUBROUTINE flioqstc (f_i,c_type,l_ex,c_name)
+!!
+!! INPUT
+!!
+!! (I) f_i     : Model file identifier
+!! (C) c_type  : Type of the coordinate ("x"/"y"/"z"/"t")
+!!
+!! OUTPUT
+!!
+!! (L) l_ex    : existence of the coordinate
+!! (C) c_name  : name of the coordinate
+!!
+!!- NOTES
+!!
+!! The following rules are used for searching variables
+!! which are spatio-temporal coordinates (x/y/z/t).
+!!
+!!-- Rule 1 : we look for a variable with one dimension
+!!--          and which has the same name as its dimension
+!!
+!!-- Rule 2 : we look for a correct "axis" attribute
+!!
+!!  Axis       Axis attribute             Number of dimensions
+!!             (case insensitive)
+!!
+!!    x         X                         1/2
+!!    y         Y                         1/2
+!!    z         Z                         1
+!!    t         T                         1
+!!
+!!-- Rule 3 : we look for a correct "standard_name" attribute
+!!
+!!  Axis       Axis attribute          Number of dimensions
+!!             (case insensitive)
+!!
+!!    x         longitude              1/2
+!!    y         latitude               1/2
+!!    z         model_level_number     1
+!!    t         time                   1
+!!
+!!-- Rule 4 : we look for a specific name
+!!
+!!  Axis   Names
+!!
+!!    x    'nav_lon' 'lon'    'longitude'
+!!    y    'nav_lat' 'lat'    'latitude'
+!!    z    'depth'   'deptht' 'height'      'level'
+!!         'lev'     'plev'   'sigma_level' 'layer'
+!!    t    'time'    'tstep'  'timesteps'
+!!
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliosync" routine synchronise one or all opened model files,
+!! to minimize data loss in case of abnormal termination.
+!!
+!! SUBROUTINE fliosync (f_i)
+!!
+!! Optional INPUT arguments
+!!
+!! (I) f_i  : Model file identifier
+!!            If this argument is not present,
+!!            all the opened model files are synchronised.
+!---------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "flioclo" routine closes one or all opened model files
+!! and frees the space needed to keep information about the files
+!!
+!! SUBROUTINE flioclo (f_i)
+!!
+!! Optional INPUT arguments
+!!
+!! (I) f_i  : Model file identifier
+!!            If this argument is not present,
+!!            all the opened model files are closed.
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! The "fliodmpf" routine dumps a model file
+!! and prints the result on the standard output.
+!!
+!! SUBROUTINE fliodmpf (f_n)
+!!
+!! INPUT
+!!
+!! (C) f_n  : Name of the model file to be dumped
+!!--------------------------------------------------------------------
+!-
+!!--------------------------------------------------------------------
+!! This "flio_dom_set" sets up the domain activity of IOIPSL.
+!! It stores all the domain information and allows it to be stored
+!! in the model file and change the file names.
+!!
+!! This routine must be called by the user before opening
+!! the model file.
+!!
+!! SUBROUTINE flio_dom_set &
+!!  & (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
+!!
+!! INPUT
+!!
+!! (I) dtnb   : total number of domains
+!! (I) dnb    : domain number
+!! (I) did(:) : distributed dimensions identifiers
+!!              (up to 5 dimensions are supported)
+!! (I) dsg(:) : total number of points for each dimension
+!! (I) dsl(:) : local number of points for each dimension
+!! (I) dpf(:) : position of first local point for each dimension
+!! (I) dpl(:) : position of last local point for each dimension
+!! (I) dhs(:) : start halo size for each dimension
+!! (I) dhe(:) : end halo size for each dimension
+!! (C) cdnm   : Model domain definition name.
+!!              The names actually supported are :
+!!              "BOX", "APPLE", "ORANGE".
+!!              These names are case insensitive.
+!!
+!! OUTPUT argument
+!!
+!! (I) id_dom : Model domain identifier
+!!
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_unset" routine unsets one or all set domains
+!! and frees the space needed to keep information about the domains
+!!
+!! This routine should be called by the user to free useless domains.
+!!
+!! SUBROUTINE flio_dom_unset (id_dom)
+!!
+!! Optional INPUT arguments
+!!
+!! (I) id_dom : Model domain identifier
+!!      >=1 & <= dom_max_nb : the domain is closed
+!!      not present         : all the set model domains are unset
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_defset" sets
+!! the default domain identifier.
+!!
+!! SUBROUTINE flio_dom_defset (id_dom)
+!!
+!! INPUT argument
+!!
+!! (I) id_dom : Model default domain identifier
+!!     ( >=1 & <= dom_max_nb )
+!!     This identifier will be able to be taken by calling
+!!     "flio_dom_definq" and used to create model files
+!!     with the corresponding domain definitions
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_defunset" routine unsets
+!! the default domain identifier.
+!!
+!! SUBROUTINE flio_dom_defunset ()
+!!
+!!--------------------------------------------------------------------
+!!
+!!--------------------------------------------------------------------
+!! The "flio_dom_definq" routine inquires about
+!! the default domain identifier.
+!! You should call this procedure to safeguard the current
+!! default domain identifier if you wish to use locally
+!! another default domain, in order to restore it.
+!!
+!! SUBROUTINE flio_dom_definq (id_dom)
+!!
+!! OUTPUT argument
+!!
+!! (I) id_dom : Model default domain identifier
+!!     IF no default domain identifier has been set,
+!!     the returned value is "FLIO_DOM_NONE".
+!!--------------------------------------------------------------------
+!-
+!---------------------------------------------------------------------
+! This is the data we keep concerning each file we open
+!---------------------------------------------------------------------
+!- For each file
+!- (I) nw_id(f_i)   : index to access at this file
+!- (I) nw_nd(f_i)   : number of dimensions
+!- (I) nw_nv(f_i)   : number of variables
+!- (I) nw_na(f_i)   : number of global attributes
+!- (I) nw_un(f_i)   : ID of the first unlimited dimension
+!- (L) lw_hm(f_i)   : for mode handling (.TRUE. define, .FALSE. data)
+!- (I) nw_di(:,f_i) : dimension IDs in the file "f_i"
+!- (I) nw_dl(:,f_i) : dimension lengths in the file "f_i"
+!- (I) nw_ai(:,f_i) : dimension Ids for the axis in the file "f_i"
+!---------------------------------------------------------------------
+  INTEGER,PARAMETER :: &
+ &  nb_fi_mx=flio_max_files, &
+ &  nb_fd_mx=flio_max_dims, &
+ &  nb_vd_mx=flio_max_var_dims
+  INTEGER,PARAMETER :: nb_ax_mx=4
+!-
+  INTEGER,PARAMETER :: k_lon=1, k_lat=2, k_lev=3, k_tim=4
+!-
+  INTEGER,DIMENSION(nb_fi_mx),SAVE :: &
+ &  nw_id=-1,nw_nd,nw_nv,nw_na,nw_un
+  LOGICAL,DIMENSION(nb_fi_mx),SAVE :: lw_hm
+  INTEGER,DIMENSION(nb_fd_mx,nb_fi_mx),SAVE :: nw_di=-1,nw_dl=-1
+  INTEGER,DIMENSION(nb_ax_mx,nb_fi_mx),SAVE :: nw_ai=-1
+!-
+! Maximum number of simultaneously defined domains
+  INTEGER,PARAMETER :: dom_max_nb=200
+!-
+! Maximum number of distributed dimensions for each domain
+  INTEGER,PARAMETER :: dom_max_dims=5
+!-
+! Default domain identifier
+  INTEGER,SAVE :: id_def_dom=FLIO_DOM_NONE
+!-
+! Supported domain definition names
+  INTEGER,PARAMETER :: n_dns=3, l_dns=7
+  CHARACTER(LEN=l_dns),DIMENSION(n_dns),SAVE :: &
+ &  c_dns=(/ "box    ","apple  ","orange "/)
+!-
+! DOMAINS related variables
+  INTEGER,DIMENSION(1:dom_max_nb),SAVE :: &
+ &  d_d_n=-1, d_n_t=0, d_n_c=0
+  INTEGER,DIMENSION(1:dom_max_dims,1:dom_max_nb),SAVE :: &
+ &  d_d_i, d_s_g, d_s_l, d_p_f, d_p_l, d_h_s, d_h_e
+  CHARACTER(LEN=l_dns),DIMENSION(1:dom_max_nb),SAVE :: c_d_t
+!-
+!===
+CONTAINS
+!===
+!-
+!---------------------------------------------------------------------
+!- Public procedures
+!---------------------------------------------------------------------
+!-
+!===
+SUBROUTINE fliocrfd (f_n,f_d_n,f_d_l,f_i,id_dom,mode,c_f_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: f_n
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: f_d_n
+  INTEGER,DIMENSION(:),INTENT(IN) :: f_d_l
+  INTEGER,INTENT(OUT) :: f_i
+  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: c_f_n
+!-
+  INTEGER :: i_rc,f_e,idid,ii,m_c,n_u
+  CHARACTER(LEN=NF90_MAX_NAME) :: f_nw
+  INTEGER,PARAMETER :: l_string=80,l_word=10
+  CHARACTER(LEN=l_string) :: c_string
+  CHARACTER(LEN=l_word)   :: c_word
+  LOGICAL :: l_ok
+  INTEGER,PARAMETER :: k_replace=1
+  INTEGER,PARAMETER :: k_32=1,k_64=2
+!- !? : Code to be activated for NETCDF4
+!?  INTEGER,PARAMETER :: k_netcdf4=1,k_classic=1
+  INTEGER,PARAMETER :: n_opt=4
+  INTEGER,DIMENSION(n_opt) :: i_opt
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliocrfd - file name : ",TRIM(f_n)
+  ENDIF
+!-
+! Search for a free local identifier
+  f_i = flio_rid()
+  IF (f_i < 0) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'Too many files.','Please increase nb_fi_mx', &
+ &   'in module fliocom.f90.')
+  ENDIF
+!-
+! Update the name of the file
+  f_nw = f_n
+  CALL flio_dom_file (f_nw,id_dom)
+!-
+! Check the dimensions
+  IF (SIZE(f_d_l) /= SIZE(f_d_n)) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'The number of names is not equal to the number of lengths', &
+ &   'for the dimensions of the file',TRIM(f_nw))
+  ENDIF
+  IF (SIZE(f_d_l) > nb_fd_mx) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'Too many dimensions','to create the file',TRIM(f_nw))
+  ENDIF
+!-
+! Check the mode
+!-
+  i_opt(:)=-1
+!-
+  IF (PRESENT(mode)) THEN
+!---
+    IF (LEN_TRIM(mode) > l_string) THEN
+      CALL ipslerr (3,'fliocrfd', &
+ &     '"mode" argument','too long','to be treated')
+    ENDIF
+    c_string = mode(:)
+    CALL strlowercase (c_string)
+!---
+    DO
+      CALL str_xfw  (c_string,c_word,l_ok)
+      IF (l_ok) THEN
+!- !? : Code to be activated for NETCDF4
+        SELECT CASE (TRIM(c_word))
+        CASE('replace')
+          IF (i_opt(1) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Replace option','already','defined')
+          ELSE
+            i_opt(1) = k_replace
+          ENDIF
+!?      CASE('netcdf4')
+!?        IF (i_opt(2) > 0) THEN
+!?          CALL ipslerr (3,'fliocrfd', &
+!? &         'Netcdf4 format','already','defined')
+!?        ELSE
+!?          i_opt(2) = k_netcdf4
+!?        ENDIF
+        CASE('32')
+          IF (i_opt(3) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Offset format','already','defined')
+          ELSE
+            i_opt(3) = k_32
+          ENDIF
+        CASE('64')
+          IF (i_opt(3) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Offset format','already','defined')
+          ELSE
+            i_opt(3) = k_64
+          ENDIF
+!?      CASE('CLASSIC')
+!?        IF (i_opt(4) > 0) THEN
+!?          CALL ipslerr (3,'fliocrfd', &
+!? &         'Netcdf4 classic format','already','defined')
+!?        ELSE
+!?          i_opt(4) = k_classic
+!?        ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'fliocrfd', &
+ &         'Option '//TRIM(c_word),'not','supported')
+        END SELECT
+      ELSE
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF (i_opt(1) == k_replace) THEN
+    m_c = NF90_CLOBBER
+  ELSE
+    m_c = NF90_NOCLOBBER
+  ENDIF
+!-
+!- Code to be replaced by the following for NETCDF4
+!?  IF (i_opt(2) == k_netcdf4) THEN
+!?    m_c = IOR(m_c,NF90_NETCDF4)
+!?    IF (i_opt(3) > 0) THEN
+!?      CALL ipslerr (3,'fliocrfd', &
+!? &     'Netcdf4 format','and offset option','are not compatible')
+!?    ELSE IF (i_opt(4) == k_classic) THEN
+!?      m_c = IOR(m_c,NF90_CLASSIC_MODEL)
+!?    ENDIF
+!?   LSE IF (i_opt(4) > 0) THEN
+!?    CALL ipslerr (3,'fliocrfd', &
+!? &   'Classic option','is reserved','for the Netcdf4 format')
+!?  ELSE
+    IF (i_opt(3) /= k_32) THEN
+      m_c = IOR(m_c,NF90_64BIT_OFFSET)
+    ENDIF
+!?  ENDIF
+!-
+! Create file (and enter the definition mode)
+  i_rc = NF90_CREATE(f_nw,m_c,f_e)
+  lw_hm(f_i) = .TRUE.
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliocrfd', &
+ &   'Could not create file :',TRIM(f_nw), &
+ &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '  fliocrfd, external model file-id : ',f_e
+  ENDIF
+!-
+! Create dimensions
+  n_u = 0
+  DO ii=1,SIZE(f_d_l)
+    IF (f_d_l(ii) == -1) THEN
+      IF (n_u == 0) THEN
+        i_rc = NF90_DEF_DIM(f_e,TRIM(f_d_n(ii)),NF90_UNLIMITED,idid)
+        n_u = n_u+1
+      ELSE
+        CALL ipslerr (3,'fliocrfd', &
+ &       'Can not handle more than one unlimited dimension', &
+ &       'for file :',TRIM(f_nw))
+      ENDIF
+    ELSE IF (f_d_l(ii) > 0) THEN
+      i_rc = NF90_DEF_DIM(f_e,TRIM(f_d_n(ii)),f_d_l(ii),idid)
+    ENDIF
+    IF ( ((f_d_l(ii) == -1).OR.(f_d_l(ii) > 0)) &
+ &      .AND.(i_rc /= NF90_NOERR) ) THEN
+      CALL ipslerr (3,'fliocrfd', &
+ &     'One dimension can not be defined', &
+ &     'for the file :',TRIM(f_nw))
+    ENDIF
+  ENDDO
+!-
+! Define "Conventions" global attribute
+  i_rc = NF90_PUT_ATT(f_e,NF90_GLOBAL,'Conventions',"CF-1.1")
+!-
+! Add the DOMAIN attributes if needed
+  CALL flio_dom_att (f_e,id_dom)
+!-
+! Keep the file information
+  nw_id(f_i) = f_e
+  CALL flio_inf (f_e, &
+ &  nb_dims=nw_nd(f_i),id_unlm=nw_un(f_i),nb_atts=nw_na(f_i), &
+ &  nn_idm=nw_di(:,f_i),nn_ldm=nw_dl(:,f_i),nn_aid=nw_ai(:,f_i))
+!-
+! Return the created file name if needed
+  IF (PRESENT(c_f_n)) THEN
+    IF (LEN(c_f_n) >= LEN_TRIM(f_nw)) THEN
+      c_f_n = TRIM(f_nw)
+    ELSE
+      CALL ipslerr (3,'fliocrfd', &
+ &     'the length of "c_f_n" is not sufficient to receive', &
+ &     'the name of the created file :',TRIM(f_nw))
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '<-fliocrfd'
+  ENDIF
+!----------------------
+END SUBROUTINE fliocrfd
+!===
+SUBROUTINE fliopstc &
+ & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+ &      t_axis,t_init,t_step,t_calendar)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  REAL,DIMENSION(:),OPTIONAL,INTENT(IN)    :: x_axis,y_axis
+  REAL,DIMENSION(:,:),OPTIONAL,INTENT(IN)  :: x_axis_2d,y_axis_2d
+  REAL,DIMENSION(:),OPTIONAL,INTENT(IN)    :: z_axis
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: t_axis
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN)     :: t_calendar
+  REAL,OPTIONAL,INTENT(IN)                 :: t_init,t_step
+!-
+  INTEGER :: i_rc,f_e
+  INTEGER :: lonid,latid,levid,timeid
+  INTEGER :: j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
+  REAL    :: dt,r_ss,v_min,v_max
+  INTEGER :: k,k_1,k_2
+  LOGICAL :: l_tmp
+  CHARACTER(LEN=20) :: c_tmp1
+  CHARACTER(LEN=40) :: c_tmp2
+  CHARACTER(LEN=80) :: c_tmp3
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliopstc"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliopstc',f_i,f_e)
+!-
+! Validate the coherence of the arguments
+!-
+  IF (    (PRESENT(x_axis).AND.PRESENT(x_axis_2d)) &
+ &    .OR.(PRESENT(y_axis).AND.PRESENT(y_axis_2d)) ) THEN
+    CALL ipslerr (3,'fliopstc', &
+ &    'The [x/y]_axis arguments', &
+ &    'are not coherent :',&
+ &    'can not handle two [x/y]_axis')
+  ENDIF
+!-
+  IF (    PRESENT(x_axis).OR.PRESENT(x_axis_2d) &
+ &    .OR.PRESENT(y_axis).OR.PRESENT(y_axis_2d) ) THEN
+    k_1=nw_ai(k_lon,f_i); k_2=nw_ai(k_lat,f_i);
+  ENDIF
+!-
+! Define the longitude axis
+!-
+  IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Longitude axis'
+    ENDIF
+!---
+    IF (PRESENT(x_axis)) THEN
+      IF (SIZE(x_axis) /= nw_dl(k_1,f_i)) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid x_axis dimension :', &
+ &       'not equal to the dimension', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ELSE
+      IF (    (SIZE(x_axis_2d,DIM=1) /= nw_dl(k_1,f_i)) &
+ &        .OR.(SIZE(x_axis_2d,DIM=2) /= nw_dl(k_2,f_i)) ) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid x_axis_2d dimensions :', &
+ &       'not equal to the dimensions', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ENDIF
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    IF (PRESENT(x_axis)) THEN
+      i_rc = NF90_DEF_VAR(f_e,"lon",NF90_REAL4, &
+ &                        nw_di(k_1,f_i),lonid)
+      v_min = MINVAL(x_axis)
+      v_max = MAXVAL(x_axis)
+    ELSE
+      i_rc = NF90_DEF_VAR(f_e,"nav_lon",NF90_REAL4, &
+ &             nw_di((/k_1,k_2/),f_i),lonid)
+      v_min = MINVAL(x_axis_2d)
+      v_max = MAXVAL(x_axis_2d)
+    ENDIF
+    i_rc = NF90_PUT_ATT(f_e,lonid,"axis","X")
+    i_rc = NF90_PUT_ATT(f_e,lonid,'standard_name',"longitude")
+    i_rc = NF90_PUT_ATT(f_e,lonid,'units',"degrees_east")
+    i_rc = NF90_PUT_ATT(f_e,lonid,'valid_min',REAL(v_min,KIND=4))
+    i_rc = NF90_PUT_ATT(f_e,lonid,'valid_max',REAL(v_max,KIND=4))
+  ENDIF
+!-
+! Define the Latitude axis
+!-
+  IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Latitude axis'
+    ENDIF
+!---
+    IF (PRESENT(y_axis)) THEN
+      IF (SIZE(y_axis) /= nw_dl(k_2,f_i)) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid y_axis dimension :', &
+ &       'not equal to the dimension', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ELSE
+      IF (    (SIZE(y_axis_2d,DIM=1) /= nw_dl(k_1,f_i)) &
+ &        .OR.(SIZE(y_axis_2d,DIM=2) /= nw_dl(k_2,f_i)) ) THEN
+        CALL ipslerr (3,'fliopstc', &
+ &       'Invalid y_axis_2d dimensions :', &
+ &       'not equal to the dimensions', &
+ &       'defined at the creation of the file')
+      ENDIF
+    ENDIF
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    IF (PRESENT(y_axis)) THEN
+      i_rc = NF90_DEF_VAR(f_e,"lat",NF90_REAL4, &
+ &                        nw_di(k_2,f_i),latid)
+      v_min = MINVAL(y_axis)
+      v_max = MAXVAL(y_axis)
+    ELSE
+      i_rc = NF90_DEF_VAR(f_e,"nav_lat",NF90_REAL4, &
+ &             nw_di((/k_1,k_2/),f_i),latid)
+      v_min = MINVAL(y_axis_2d)
+      v_max = MAXVAL(y_axis_2d)
+    ENDIF
+    i_rc = NF90_PUT_ATT(f_e,latid,"axis","Y")
+    i_rc = NF90_PUT_ATT(f_e,latid,'standard_name',"latitude")
+    i_rc = NF90_PUT_ATT(f_e,latid,'units',"degrees_north")
+    i_rc = NF90_PUT_ATT(f_e,latid,'valid_min',REAL(v_min,KIND=4))
+    i_rc = NF90_PUT_ATT(f_e,latid,'valid_max',REAL(v_max,KIND=4))
+  ENDIF
+!-
+! Define the Vertical axis
+!-
+  IF (PRESENT(z_axis)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Vertical axis'
+    ENDIF
+!---
+    k_1=nw_ai(k_lev,f_i);
+!---
+    IF (SIZE(z_axis) /= nw_dl(k_1,f_i)) THEN
+      CALL ipslerr (3,'fliopstc', &
+ &     'Invalid z_axis dimension :', &
+ &     'not equal to the dimension', &
+ &     'defined at the creation of the file')
+    ENDIF
+!---
+    v_min = MINVAL(z_axis)
+    v_max = MAXVAL(z_axis)
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_DEF_VAR(f_e,'lev',NF90_REAL4, &
+ &                      nw_di(k_1,f_i),levid)
+    i_rc = NF90_PUT_ATT(f_e,levid,"axis","Z")
+    i_rc = NF90_PUT_ATT(f_e,levid,'standard_name','model_level_number')
+    i_rc = NF90_PUT_ATT(f_e,levid,'units','sigma_level')
+    i_rc = NF90_PUT_ATT(f_e,levid,'long_name','Sigma Levels')
+    i_rc = NF90_PUT_ATT(f_e,levid,'valid_min',REAL(v_min,KIND=4))
+    i_rc = NF90_PUT_ATT(f_e,levid,'valid_max',REAL(v_max,KIND=4))
+  ENDIF
+!-
+! Define the Time axis
+!-
+  IF (PRESENT(t_axis).AND.PRESENT(t_init).AND.PRESENT(t_step)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Define the Time axis'
+    ENDIF
+!---
+    k_1=nw_ai(k_tim,f_i);
+!---
+    IF (     (nw_dl(k_1,f_i) /= 0) &
+ &      .AND.(SIZE(t_axis) /= nw_dl(k_1,f_i)) ) THEN
+      CALL ipslerr (3,'fliopstc', &
+ &     'Invalid t_axis dimension :', &
+ &     'not equal to the dimension', &
+ &     'defined at the creation of the file')
+    ENDIF
+!-- Retrieve the calendar date
+    CALL lock_calendar (old_status=l_tmp)
+    IF (PRESENT(t_calendar)) THEN
+      CALL ioget_calendar (c_tmp1)
+      CALL lock_calendar (new_status=.FALSE.)
+      CALL ioconf_calendar (TRIM(t_calendar))
+    ENDIF
+    CALL ju2ymds (t_init,j_yy,j_mo,j_dd,r_ss)
+    IF (PRESENT(t_calendar)) THEN
+      CALL lock_calendar (new_status=.FALSE.)
+      CALL ioconf_calendar (TRIM(c_tmp1))
+    ENDIF
+    CALL lock_calendar (new_status=l_tmp)
+!--
+    k=NINT(r_ss)
+    j_hh=k/3600
+    k=k-3600*j_hh
+    j_mn=k/60
+    j_ss=k-60*j_mn
+!-- Calculate the step unit
+    IF      (ABS(t_step) >= 604800.) THEN
+      dt = t_step/604800.
+      c_tmp2 = 'weeks'
+    ELSE IF (ABS(t_step) >= 86400.) THEN
+      dt = t_step/86400.
+      c_tmp2 = 'days'
+    ELSE IF (ABS(t_step) >=  3600.) THEN
+      dt = t_step/3600.
+      c_tmp2 = 'hours'
+    ELSE IF (ABS(t_step) >=    60.) THEN
+      dt = t_step/60.
+      c_tmp2 = 'minutes'
+    ELSE
+      dt = t_step
+      c_tmp2 = 'seconds'
+    ENDIF
+!---
+    c_tmp1 = ''
+    IF (ABS(dt-NINT(dt)) <= ABS(10.*EPSILON(dt))) THEN
+      IF (NINT(dt) /= 1) THEN
+        WRITE (UNIT=c_tmp1,FMT='(I15)') NINT(dt)
+      ENDIF
+    ELSE
+      IF (dt < 1.) THEN
+       WRITE (UNIT=c_tmp1,FMT='(F8.5)') dt
+      ELSE
+       WRITE (UNIT=c_tmp1,FMT='(F17.5)') dt
+      ENDIF
+      DO k=LEN_TRIM(c_tmp1),1,-1
+        IF (c_tmp1(k:k) /= '0') THEN
+          EXIT
+        ELSE
+          c_tmp1(k:k) = ' '
+        ENDIF
+      ENDDO
+    ENDIF
+    c_tmp2 = TRIM(c_tmp1)//' '//TRIM(c_tmp2)
+    WRITE (UNIT=c_tmp3, &
+ &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    TRIM(ADJUSTL(c_tmp2))//' since ',j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
+!---
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_DEF_VAR(f_e,'time',NF90_REAL4, &
+ &                      nw_di(k_1,f_i),timeid)
+    i_rc = NF90_PUT_ATT(f_e,timeid,"axis",'T')
+    i_rc = NF90_PUT_ATT(f_e,timeid,'standard_name','time')
+    i_rc = NF90_PUT_ATT(f_e,timeid,'long_name','time steps')
+    IF (PRESENT(t_calendar)) THEN
+      i_rc = NF90_PUT_ATT(f_e,timeid,'calendar',TRIM(t_calendar))
+    ENDIF
+    i_rc = NF90_PUT_ATT(f_e,timeid,'units',TRIM(c_tmp3))
+  ELSE IF (PRESENT(t_axis).OR.PRESENT(t_init).OR.PRESENT(t_step)) THEN
+    CALL ipslerr (3,'fliopstc', &
+ &   'For time axis and coordinates', &
+ &   'arguments t_axis AND t_init AND t_step', &
+ &   'must be PRESENT')
+  ENDIF
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+! Create the longitude axis
+!-
+  IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Longitude axis'
+    ENDIF
+    IF (PRESENT(x_axis)) THEN
+      i_rc = NF90_PUT_VAR(f_e,lonid,x_axis(:))
+    ELSE
+      i_rc = NF90_PUT_VAR(f_e,lonid,x_axis_2d(:,:))
+    ENDIF
+  ENDIF
+!-
+! Create the Latitude axis
+!-
+  IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Latitude axis'
+    ENDIF
+    IF (PRESENT(y_axis)) THEN
+      i_rc = NF90_PUT_VAR(f_e,latid,y_axis(:))
+    ELSE
+      i_rc = NF90_PUT_VAR(f_e,latid,y_axis_2d(:,:))
+    ENDIF
+  ENDIF
+!-
+! Create the Vertical axis
+!-
+  IF (PRESENT(z_axis)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Vertical axis'
+    ENDIF
+    i_rc = NF90_PUT_VAR(f_e,levid,z_axis(:))
+  ENDIF
+!-
+! Create the Time axis
+!-
+  IF (PRESENT(t_axis)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliopstc : Create the Time axis'
+    ENDIF
+    i_rc = NF90_PUT_VAR(f_e,timeid,REAL(t_axis(:)))
+  ENDIF
+!-
+! Keep all this information
+!-
+  CALL flio_inf (f_e,nb_vars=nw_nv(f_i),nb_atts=nw_na(f_i))
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliopstc"
+  ENDIF
+!----------------------
+END SUBROUTINE fliopstc
+!===
+SUBROUTINE fliodv_r0d &
+ & (f_i,v_n,v_t, &
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER,OPTIONAL,INTENT(IN) :: v_t
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
+ & axis,standard_name,long_name,units
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
+!---------------------------------------------------------------------
+  CALL flio_udv &
+ &  (f_i,0,v_n,(/0/),v_t, &
+ &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!------------------------
+END SUBROUTINE fliodv_r0d
+!===
+SUBROUTINE fliodv_rnd &
+ & (f_i,v_n,v_d,v_t, &
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER,DIMENSION(:),INTENT(IN) :: v_d
+  INTEGER,OPTIONAL,INTENT(IN) :: v_t
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
+ & axis,standard_name,long_name,units
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
+!---------------------------------------------------------------------
+  CALL flio_udv &
+ &  (f_i,SIZE(v_d),v_n,v_d,v_t, &
+ &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!------------------------
+END SUBROUTINE fliodv_rnd
+!===
+SUBROUTINE flio_udv &
+ & (f_i,n_d,v_n,v_d,v_t, &
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i,n_d
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER,DIMENSION(:),INTENT(IN) :: v_d
+  INTEGER,OPTIONAL,INTENT(IN) :: v_t
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
+ & axis,standard_name,long_name,units
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
+!-
+  INTEGER :: f_e,m_k,i_v,i_rc,ii,idd
+  INTEGER,DIMENSION(nb_vd_mx) :: a_i
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliodefv ",TRIM(v_n)," ",n_d,"D"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliodefv',f_i,f_e)
+!-
+  IF (n_d > 0) THEN
+    IF (n_d > nb_vd_mx) THEN
+      CALL ipslerr (3,'fliodefv', &
+ &     'Too many dimensions', &
+ &     'required for the variable',TRIM(v_n))
+    ENDIF
+  ENDIF
+!-
+  DO ii=1,n_d
+    IF ( (v_d(ii) >= 1).AND.(v_d(ii) <= nb_fd_mx) ) THEN
+      idd = nw_di(v_d(ii),f_i)
+      IF (idd > 0) THEN
+        a_i(ii) = idd
+      ELSE
+        CALL ipslerr (3,'fliodefv', &
+ &       'Invalid dimension identifier','(not defined)',' ')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliodefv', &
+ &     'Invalid dimension identifier','(not supported)',' ')
+    ENDIF
+  ENDDO
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+!---
+    IF (PRESENT(v_t)) THEN
+      SELECT CASE (v_t)
+      CASE(flio_i)
+        IF (i_std == i_8) THEN
+!-------- I8 not yet supported by NETCDF
+!-------- m_k = flio_i8
+          m_k = flio_i4
+        ELSE
+          m_k = flio_i4
+        ENDIF
+      CASE(flio_r)
+        IF (r_std == r_8) THEN
+          m_k = flio_r8
+        ELSE
+          m_k = flio_r4
+        ENDIF
+      CASE(flio_c,flio_i1,flio_i2,flio_i4,flio_r4,flio_r8)
+        m_k = v_t
+      CASE DEFAULT
+        CALL ipslerr (3,'fliodefv', &
+ &        'Variable '//TRIM(v_n),'External type','not supported')
+      END SELECT
+    ELSE IF (r_std == r_8) THEN
+      m_k = flio_r8
+    ELSE
+      m_k = flio_r4
+    ENDIF
+!---
+    IF (n_d > 0) THEN
+      i_rc = NF90_DEF_VAR(f_e,v_n,m_k,a_i(1:n_d),i_v)
+    ELSE
+      i_rc = NF90_DEF_VAR(f_e,v_n,m_k,i_v)
+    ENDIF
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliodefv', &
+ &      'Variable '//TRIM(v_n)//' not defined','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+    nw_nv(f_i) = nw_nv(f_i)+1
+!---
+    IF (PRESENT(axis)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'axis',TRIM(axis))
+    ENDIF
+    IF (PRESENT(standard_name)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'standard_name',TRIM(standard_name))
+    ENDIF
+    IF (PRESENT(long_name)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'long_name',TRIM(long_name))
+    ENDIF
+    IF (PRESENT(units)) THEN
+      i_rc = NF90_PUT_ATT(f_e,i_v,'units',TRIM(units))
+    ENDIF
+    IF (PRESENT(valid_min)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute valid_min', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+    IF (PRESENT(valid_max)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute valid_max', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+    IF (PRESENT(fillvalue)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute fillvalue', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+!---
+  ELSE
+    CALL ipslerr (3,'fliodefv','Variable',TRIM(v_n),'already exist')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliodefv"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_udv
+!===
+SUBROUTINE fliopv_i40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_i40
+!===
+SUBROUTINE fliopv_i41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i41
+!===
+SUBROUTINE fliopv_i42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i42
+!===
+SUBROUTINE fliopv_i43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i43
+!===
+SUBROUTINE fliopv_i44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i44
+!===
+SUBROUTINE fliopv_i45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i45
+!===
+SUBROUTINE fliopv_i20 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_20=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_i20
+!===
+SUBROUTINE fliopv_i21 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_21=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i21
+!===
+SUBROUTINE fliopv_i22 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_22=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i22
+!===
+SUBROUTINE fliopv_i23 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_23=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i23
+!===
+SUBROUTINE fliopv_i24 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_24=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i24
+!===
+SUBROUTINE fliopv_i25 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,i_25=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_i25
+!===
+!?INTEGERS of KIND 1 are not supported on all computers
+!?SUBROUTINE fliopv_i10 (f_i,v_n,v_v,start)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_10=v_v,start=start)
+!?!------------------------
+!?END SUBROUTINE fliopv_i10
+!?!===
+!?SUBROUTINE fliopv_i11 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_11=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i11
+!?!===
+!?SUBROUTINE fliopv_i12 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_12=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i12
+!?!===
+!?SUBROUTINE fliopv_i13 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_13=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i13
+!?!===
+!?SUBROUTINE fliopv_i14 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_14=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i14
+!?!===
+!?SUBROUTINE fliopv_i15 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_upv (f_i,v_n,i_15=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliopv_i15
+!===
+SUBROUTINE fliopv_r40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_r40
+!===
+SUBROUTINE fliopv_r41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r41
+!===
+SUBROUTINE fliopv_r42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r42
+!===
+SUBROUTINE fliopv_r43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r43
+!===
+SUBROUTINE fliopv_r44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r44
+!===
+SUBROUTINE fliopv_r45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r45
+!===
+SUBROUTINE fliopv_r80 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_80=v_v,start=start)
+!------------------------
+END SUBROUTINE fliopv_r80
+!===
+SUBROUTINE fliopv_r81 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_81=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r81
+!===
+SUBROUTINE fliopv_r82 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_82=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r82
+!===
+SUBROUTINE fliopv_r83 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_83=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r83
+!===
+SUBROUTINE fliopv_r84 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_84=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r84
+!===
+SUBROUTINE fliopv_r85 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(IN) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_upv (f_i,v_n,r_85=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliopv_r85
+!===
+SUBROUTINE flio_upv &
+ & (f_i,v_n, &
+ &  i_40,i_41,i_42,i_43,i_44,i_45, &
+ &  i_20,i_21,i_22,i_23,i_24,i_25, &
+!? &  i_10,i_11,i_12,i_13,i_14,i_15, &
+ &  r_40,r_41,r_42,r_43,r_44,r_45, &
+ &  r_80,r_81,r_82,r_83,r_84,r_85, &
+ &  start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(IN),OPTIONAL :: i_40
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(IN),OPTIONAL :: i_41
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_42
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_43
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_44
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_45
+  INTEGER(KIND=i_2),INTENT(IN),OPTIONAL :: i_20
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(IN),OPTIONAL :: i_21
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_22
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_23
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_24
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_25
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1),INTENT(IN),OPTIONAL :: i_10
+!?INTEGER(KIND=i_1),DIMENSION(:),INTENT(IN),OPTIONAL :: i_11
+!?INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(IN),OPTIONAL :: i_12
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: i_13
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: i_14
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: i_15
+  REAL(KIND=r_4),INTENT(IN),OPTIONAL :: r_40
+  REAL(KIND=r_4),DIMENSION(:),INTENT(IN),OPTIONAL :: r_41
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(IN),OPTIONAL :: r_42
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: r_43
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: r_44
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: r_45
+  REAL(KIND=r_8),INTENT(IN),OPTIONAL :: r_80
+  REAL(KIND=r_8),DIMENSION(:),INTENT(IN),OPTIONAL :: r_81
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(IN),OPTIONAL :: r_82
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: r_83
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(IN),OPTIONAL :: r_84
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(IN),OPTIONAL :: r_85
+  INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL :: start,count
+!-
+  INTEGER :: f_e,i_v,i_rc
+  CHARACTER(LEN=5) :: cvr_d
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    IF      (PRESENT(i_40)) THEN; cvr_d = "I1 0D";
+    ELSE IF (PRESENT(i_41)) THEN; cvr_d = "I1 1D";
+    ELSE IF (PRESENT(i_42)) THEN; cvr_d = "I1 2D";
+    ELSE IF (PRESENT(i_43)) THEN; cvr_d = "I1 3D";
+    ELSE IF (PRESENT(i_44)) THEN; cvr_d = "I1 4D";
+    ELSE IF (PRESENT(i_45)) THEN; cvr_d = "I1 5D";
+    ELSE IF (PRESENT(i_20)) THEN; cvr_d = "I2 0D";
+    ELSE IF (PRESENT(i_21)) THEN; cvr_d = "I2 1D";
+    ELSE IF (PRESENT(i_22)) THEN; cvr_d = "I2 2D";
+    ELSE IF (PRESENT(i_23)) THEN; cvr_d = "I2 3D";
+    ELSE IF (PRESENT(i_24)) THEN; cvr_d = "I2 4D";
+    ELSE IF (PRESENT(i_25)) THEN; cvr_d = "I2 5D";
+!?  ELSE IF (PRESENT(i_10)) THEN; cvr_d = "I4 0D";
+!?  ELSE IF (PRESENT(i_11)) THEN; cvr_d = "I4 1D";
+!?  ELSE IF (PRESENT(i_12)) THEN; cvr_d = "I4 2D";
+!?  ELSE IF (PRESENT(i_13)) THEN; cvr_d = "I4 3D";
+!?  ELSE IF (PRESENT(i_14)) THEN; cvr_d = "I4 4D";
+!?  ELSE IF (PRESENT(i_15)) THEN; cvr_d = "I4 5D";
+    ELSE IF (PRESENT(r_40)) THEN; cvr_d = "R4 0D";
+    ELSE IF (PRESENT(r_41)) THEN; cvr_d = "R4 1D";
+    ELSE IF (PRESENT(r_42)) THEN; cvr_d = "R4 2D";
+    ELSE IF (PRESENT(r_43)) THEN; cvr_d = "R4 3D";
+    ELSE IF (PRESENT(r_44)) THEN; cvr_d = "R4 4D";
+    ELSE IF (PRESENT(r_45)) THEN; cvr_d = "R4 5D";
+    ELSE IF (PRESENT(r_80)) THEN; cvr_d = "R8 0D";
+    ELSE IF (PRESENT(r_81)) THEN; cvr_d = "R8 1D";
+    ELSE IF (PRESENT(r_82)) THEN; cvr_d = "R8 2D";
+    ELSE IF (PRESENT(r_83)) THEN; cvr_d = "R8 3D";
+    ELSE IF (PRESENT(r_84)) THEN; cvr_d = "R8 4D";
+    ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
+    ENDIF
+    WRITE(*,*) "->flioputv ",TRIM(v_n)," ",TRIM(cvr_d)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioputv',f_i,f_e)
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+  IF (i_rc == NF90_NOERR) THEN
+    IF      (PRESENT(i_40)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_40,start=start)
+    ELSE IF (PRESENT(i_41)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_41,start=start,count=count)
+    ELSE IF (PRESENT(i_42)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_42,start=start,count=count)
+    ELSE IF (PRESENT(i_43)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_43,start=start,count=count)
+    ELSE IF (PRESENT(i_44)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_44,start=start,count=count)
+    ELSE IF (PRESENT(i_45)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_45,start=start,count=count)
+    ELSE IF (PRESENT(i_20)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_20,start=start)
+    ELSE IF (PRESENT(i_21)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_21,start=start,count=count)
+    ELSE IF (PRESENT(i_22)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_22,start=start,count=count)
+    ELSE IF (PRESENT(i_23)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_23,start=start,count=count)
+    ELSE IF (PRESENT(i_24)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_24,start=start,count=count)
+    ELSE IF (PRESENT(i_25)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,i_25,start=start,count=count)
+!?  ELSE IF (PRESENT(i_10)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_10,start=start)
+!?  ELSE IF (PRESENT(i_11)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_11,start=start,count=count)
+!?  ELSE IF (PRESENT(i_12)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_12,start=start,count=count)
+!?  ELSE IF (PRESENT(i_13)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_13,start=start,count=count)
+!?  ELSE IF (PRESENT(i_14)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_14,start=start,count=count)
+!?  ELSE IF (PRESENT(i_15)) THEN
+!?    i_rc = NF90_PUT_VAR(f_e,i_v,i_15,start=start,count=count)
+    ELSE IF (PRESENT(r_40)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_40,start=start)
+    ELSE IF (PRESENT(r_41)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_41,start=start,count=count)
+    ELSE IF (PRESENT(r_42)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_42,start=start,count=count)
+    ELSE IF (PRESENT(r_43)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_43,start=start,count=count)
+    ELSE IF (PRESENT(r_44)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_44,start=start,count=count)
+    ELSE IF (PRESENT(r_45)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_45,start=start,count=count)
+    ELSE IF (PRESENT(r_80)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_80,start=start)
+    ELSE IF (PRESENT(r_81)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_81,start=start,count=count)
+    ELSE IF (PRESENT(r_82)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_82,start=start,count=count)
+    ELSE IF (PRESENT(r_83)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_83,start=start,count=count)
+    ELSE IF (PRESENT(r_84)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_84,start=start,count=count)
+    ELSE IF (PRESENT(r_85)) THEN
+      i_rc = NF90_PUT_VAR(f_e,i_v,r_85,start=start,count=count)
+    ENDIF
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'flioputv', &
+ &      'Variable '//TRIM(v_n)//' not put','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+  ELSE
+    CALL ipslerr (3,'flioputv','Variable',TRIM(v_n),'not defined')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioputv"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_upv
+!===
+SUBROUTINE fliopa_r4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avr4=(/a_v/))
+!--------------------------
+END SUBROUTINE fliopa_r4_0d
+!===
+SUBROUTINE fliopa_r4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),DIMENSION(:),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avr4=a_v)
+!--------------------------
+END SUBROUTINE fliopa_r4_1d
+!===
+SUBROUTINE fliopa_r8_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avr8=(/a_v/))
+!--------------------------
+END SUBROUTINE fliopa_r8_0d
+!===
+SUBROUTINE fliopa_r8_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),DIMENSION(:),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avr8=a_v)
+!--------------------------
+END SUBROUTINE fliopa_r8_1d
+!===
+SUBROUTINE fliopa_i4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avi4=(/a_v/))
+!--------------------------
+END SUBROUTINE fliopa_i4_0d
+!===
+SUBROUTINE fliopa_i4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),DIMENSION(:),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,SIZE(a_v),v_n,a_n,avi4=a_v)
+!--------------------------
+END SUBROUTINE fliopa_i4_1d
+!===
+SUBROUTINE fliopa_tx_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  CHARACTER(LEN=*),INTENT(IN) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_upa (f_i,1,v_n,a_n,avtx=a_v)
+!--------------------------
+END SUBROUTINE fliopa_tx_0d
+!===
+SUBROUTINE flio_upa (f_i,l_a,v_n,a_n,avr4,avr8,avi4,avtx)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i,l_a
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),DIMENSION(:),OPTIONAL,INTENT(IN) :: avr4
+  REAL(KIND=8),DIMENSION(:),OPTIONAL,INTENT(IN) :: avr8
+  INTEGER(KIND=4),DIMENSION(:),OPTIONAL,INTENT(IN) :: avi4
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: avtx
+!-
+  INTEGER :: f_e,i_v,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioputa ",TRIM(v_n)," ",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioputa',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'flioputa', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,attnum=i_a)
+  IF ( (i_v == NF90_GLOBAL).AND.(i_rc /= NF90_NOERR) ) THEN
+    nw_na(f_i) = nw_na(f_i)+1
+  ENDIF
+  CALL flio_hdm (f_i,f_e,.TRUE.)
+  IF      (PRESENT(avr4)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avr4(1:l_a))
+  ELSE IF (PRESENT(avr8)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avr8(1:l_a))
+  ELSE IF (PRESENT(avi4)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,avi4(1:l_a))
+  ELSE IF (PRESENT(avtx)) THEN
+    i_rc = NF90_PUT_ATT(f_e,i_v,a_n,TRIM(avtx))
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioputa"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_upa
+!===
+SUBROUTINE flioopfd (f_n,f_i,mode,nb_dim,nb_var,nb_gat)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: f_n
+  INTEGER,INTENT(OUT) :: f_i
+  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: mode
+  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dim,nb_var,nb_gat
+!-
+  INTEGER :: i_rc,f_e,m_c
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '->flioopfd, file name : ',TRIM(f_n)
+  ENDIF
+!-
+! Search for a free local identifier
+!-
+  f_i = flio_rid()
+  IF (f_i < 0) THEN
+    CALL ipslerr (3,'flioopfd', &
+      'Too many files.','Please increase nb_fi_mx', &
+      'in module fliocom.f90.')
+  ENDIF
+!-
+! Check the mode
+!-
+  IF (PRESENT(mode)) THEN
+    IF (TRIM(mode) == "WRITE") THEN
+      m_c = NF90_WRITE
+    ELSE
+      m_c = NF90_NOWRITE
+    ENDIF
+  ELSE
+    m_c = NF90_NOWRITE
+  ENDIF
+!-
+! Open the file.
+!-
+  i_rc = NF90_OPEN(TRIM(f_n),m_c,f_e)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'flioopfd', &
+ &   'Could not open file :',TRIM(f_n), &
+ &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) '  flioopfd, model file-id : ',f_e
+  ENDIF
+!-
+! Retrieve and keep information about the file
+!-
+  nw_id(f_i) = f_e
+  lw_hm(f_i) = .FALSE.
+  CALL flio_inf (f_e, &
+ &  nb_dims=nw_nd(f_i),nb_vars=nw_nv(f_i), &
+ &  nb_atts=nw_na(f_i),id_unlm=nw_un(f_i), &
+ &  nn_idm=nw_di(:,f_i),nn_ldm=nw_dl(:,f_i),nn_aid=nw_ai(:,f_i))
+!-
+! Return information to the user
+!-
+  IF (PRESENT(nb_dim)) THEN
+    nb_dim = nw_nd(f_i)
+  ENDIF
+  IF (PRESENT(nb_var)) THEN
+    nb_var = nw_nv(f_i)
+  ENDIF
+  IF (PRESENT(nb_gat)) THEN
+    nb_gat = nw_na(f_i)
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,'("   flioopfd - dimensions :",/,(5(1X,I10),:))') &
+ &    nw_dl(:,f_i)
+    WRITE(*,*) "<-flioopfd"
+  ENDIF
+!----------------------
+END SUBROUTINE flioopfd
+!===
+SUBROUTINE flioinqf &
+ & (f_i,nb_dim,nb_var,nb_gat,id_uld,id_dim,ln_dim)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dim,nb_var,nb_gat,id_uld
+  INTEGER,OPTIONAL,INTENT(OUT),DIMENSION(:) :: id_dim,ln_dim
+!-
+  INTEGER :: lll
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqf"
+  ENDIF
+!-
+  IF ( (f_i < 1).OR.(f_i > nb_fi_mx) ) THEN
+    CALL ipslerr (2,'flioinqf', &
+ &   'Invalid file identifier',' ',' ')
+  ELSE IF (nw_id(f_i) <= 0) THEN
+    CALL ipslerr (2,'flioinqf', &
+ &   'Unable to inquire about the file :','probably','not opened')
+  ELSE
+    IF (PRESENT(nb_dim)) THEN
+      nb_dim = nw_nd(f_i)
+    ENDIF
+    IF (PRESENT(nb_var)) THEN
+      nb_var = nw_nv(f_i)
+    ENDIF
+    IF (PRESENT(nb_gat)) THEN
+      nb_gat = nw_na(f_i)
+    ENDIF
+    IF (PRESENT(id_uld)) THEN
+      id_uld = nw_un(f_i)
+    ENDIF
+    IF (PRESENT(id_dim)) THEN
+      lll = SIZE(id_dim)
+      IF (lll < nw_nd(f_i)) THEN
+        CALL ipslerr (2,'flioinqf', &
+ &       'Only the first identifiers', &
+ &       'of the dimensions','will be returned')
+      ENDIF
+      lll=MIN(SIZE(id_dim),nw_nd(f_i))
+      id_dim(1:lll) = nw_di(1:lll,f_i)
+    ENDIF
+    IF (PRESENT(ln_dim)) THEN
+      lll = SIZE(ln_dim)
+      IF (lll < nw_nd(f_i)) THEN
+        CALL ipslerr (2,'flioinqf', &
+ &       'Only the first lengths', &
+ &       'of the dimensions','will be returned')
+      ENDIF
+      lll=MIN(SIZE(ln_dim),nw_nd(f_i))
+      ln_dim(1:lll) = nw_dl(1:lll,f_i)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqf"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqf
+!===
+SUBROUTINE flioinqn &
+ & (f_i,cn_dim,cn_var,cn_gat,cn_uld, &
+ &  id_start,id_count,iv_start,iv_count,ia_start,ia_count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: &
+ & cn_dim,cn_var,cn_gat
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: &
+ & cn_uld
+  INTEGER,OPTIONAL,INTENT(IN) :: &
+ & id_start,id_count,iv_start,iv_count,ia_start,ia_count
+!-
+  INTEGER :: f_e,i_s,i_w,iws,iwc,i_rc
+  LOGICAL :: l_ok
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqn"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioinqn',f_i,f_e)
+!-
+  IF (PRESENT(cn_dim)) THEN
+    l_ok = .TRUE.
+    i_s = SIZE(cn_dim)
+    DO i_w=1,i_s
+      cn_dim(i_w)(:) = '?'
+    ENDDO
+    IF (PRESENT(id_start)) THEN
+      iws = id_start
+    ELSE
+      iws = 1
+    ENDIF
+    IF (PRESENT(id_count)) THEN
+      iwc = id_count
+    ELSE
+      iwc = nw_nd(f_i)
+    ENDIF
+    IF (iws > nw_nd(f_i)) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested dimensions', &
+ &     'is greater than the number of dimensions', &
+ &     'in the file')
+    ELSE IF (iws < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested dimensions', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF ((iws+iwc-1) > nw_nd(f_i)) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested dimensions', &
+ &     'is greater than the number of dimensions', &
+ &     'in the file')
+    ENDIF
+    IF (iwc > i_s) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of dimensions to retrieve', &
+ &     'is greater than the size of the array,', &
+ &     'only the first dimensions of the file will be returned')
+    ELSE IF (iwc < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested dimensions', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF (l_ok) THEN
+      DO i_w=1,MIN(iwc,i_s,nw_nd(f_i)-iws+1)
+        i_rc = NF90_INQUIRE_DIMENSION(f_e,i_w+iws-1,name=cn_dim(i_w))
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+  IF (PRESENT(cn_var)) THEN
+    l_ok = .TRUE.
+    i_s = SIZE(cn_var)
+    DO i_w=1,i_s
+      cn_var(i_w)(:) = '?'
+    ENDDO
+    IF (PRESENT(iv_start)) THEN
+      iws = iv_start
+    ELSE
+      iws = 1
+    ENDIF
+    IF (PRESENT(iv_count)) THEN
+      iwc = iv_count
+    ELSE
+      iwc = nw_nv(f_i)
+    ENDIF
+    IF (iws > nw_nv(f_i)) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested variables', &
+ &     'is greater than the number of variables', &
+ &     'in the file')
+    ELSE IF (iws < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested variables', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF ((iws+iwc-1) > nw_nv(f_i)) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested variables', &
+ &     'is greater than the number of variables', &
+ &     'in the file')
+    ENDIF
+    IF (iwc > i_s) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of variables to retrieve', &
+ &     'is greater than the size of the array,', &
+ &     'only the first variables of the file will be returned')
+    ELSE IF (iwc < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested variables', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF (l_ok) THEN
+      DO i_w=1,MIN(iwc,i_s,nw_nv(f_i)-iws+1)
+        i_rc = NF90_INQUIRE_VARIABLE(f_e,i_w+iws-1,name=cn_var(i_w))
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+  IF (PRESENT(cn_gat)) THEN
+    l_ok = .TRUE.
+    i_s = SIZE(cn_gat)
+    DO i_w=1,i_s
+      cn_gat(i_w)(:) = '?'
+    ENDDO
+    IF (PRESENT(ia_start)) THEN
+      iws = ia_start
+    ELSE
+      iws = 1
+    ENDIF
+    IF (PRESENT(ia_count)) THEN
+      iwc = ia_count
+    ELSE
+      iwc = nw_na(f_i)
+    ENDIF
+    IF (iws > nw_na(f_i)) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested global attributes', &
+ &     'is greater than the number of global attributes', &
+ &     'in the file')
+    ELSE IF (iws < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The start index of requested global attributes', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF ((iws+iwc-1) > nw_na(f_i)) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested global attributes', &
+ &     'is greater than the number of global attributes', &
+ &     'in the file')
+    ENDIF
+    IF (iwc > i_s) THEN
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of global attributes to retrieve', &
+ &     'is greater than the size of the array,', &
+ &     'only the first global attributes of the file will be returned')
+    ELSE IF (iwc < 1) THEN
+      l_ok = .FALSE.
+      CALL ipslerr (2,'flioinqn', &
+ &     'The number of requested global attributes', &
+ &     'is invalid', &
+ &     '( < 1 )')
+    ENDIF
+    IF (l_ok) THEN
+      DO i_w=1,MIN(iwc,i_s,nw_na(f_i)-iws+1)
+        i_rc = NF90_INQ_ATTNAME(f_e, &
+ &              NF90_GLOBAL,i_w+iws-1,name=cn_gat(i_w))
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+  IF (PRESENT(cn_uld)) THEN
+    cn_uld = '?'
+    IF (nw_un(f_i) > 0) THEN
+      i_rc = NF90_INQUIRE_DIMENSION(f_e,nw_un(f_i),name=cn_uld)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqn"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqn
+!===
+SUBROUTINE fliogstc &
+ & (f_i,x_axis,x_axis_2d,y_axis,y_axis_2d,z_axis, &
+ &      t_axis,t_init,t_step,t_calendar, &
+ &      x_start,x_count,y_start,y_count, &
+ &      z_start,z_count,t_start,t_count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  REAL,DIMENSION(:),OPTIONAL,INTENT(OUT)    :: x_axis,y_axis
+  REAL,DIMENSION(:,:),OPTIONAL,INTENT(OUT)  :: x_axis_2d,y_axis_2d
+  REAL,DIMENSION(:),OPTIONAL,INTENT(OUT)    :: z_axis
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: t_axis
+  REAL,OPTIONAL,INTENT(OUT)                 :: t_init,t_step
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT)     :: t_calendar
+  INTEGER,OPTIONAL,INTENT(IN) :: &
+ &  x_start,x_count,y_start,y_count,z_start,z_count,t_start,t_count
+!-
+  INTEGER :: i_rc,f_e,i_v,it_t,nbdim,kv
+  INTEGER :: m_x,i_x,l_x,m_y,i_y,l_y,m_z,i_z,l_z,m_t,i_t,l_t
+  CHARACTER(LEN=NF90_MAX_NAME) :: name
+  CHARACTER(LEN=80) :: units
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=1) :: c_1
+  REAL    :: r_yy,r_mo,r_dd,r_ss,dtv,dtn
+  INTEGER :: j_yy,j_mo,j_dd,j_hh,j_mn,j_ss
+  LOGICAL :: l_ok,l_tmp
+!-
+  REAL,DIMENSION(:),ALLOCATABLE :: v_tmp
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliogstc"
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliogstc',f_i,f_e)
+!-
+! Validate the coherence of the arguments
+!-
+  IF (    (PRESENT(x_axis).AND.PRESENT(x_axis_2d)) &
+ &    .OR.(PRESENT(y_axis).AND.PRESENT(y_axis_2d)) ) THEN
+    CALL ipslerr (3,'fliogstc', &
+ &    'The [x/y]_axis arguments', &
+ &    'are not coherent :',&
+ &    'can not handle two [x/y]_axis')
+  ENDIF
+!-
+! Retrieve spatio-temporal dimensions
+!-
+  IF (nw_ai(k_lon,f_i) > 0) THEN
+    m_x = nw_dl(nw_ai(k_lon,f_i),f_i);
+  ELSE
+    m_x = -1;
+  ENDIF
+  IF (nw_ai(k_lat,f_i) > 0) THEN
+    m_y = nw_dl(nw_ai(k_lat,f_i),f_i);
+  ELSE
+    m_y = -1;
+  ENDIF
+  IF (nw_ai(k_lev,f_i) > 0) THEN
+    m_z = nw_dl(nw_ai(k_lev,f_i),f_i);
+  ELSE
+    m_z = -1;
+  ENDIF
+  IF (nw_ai(k_tim,f_i) > 0) THEN
+    m_t = nw_dl(nw_ai(k_tim,f_i),f_i);
+  ELSE
+    m_t = -1;
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,'("   fliogstc - dimensions :",/,(5(1X,I10),:))') &
+ &    m_x,m_y,m_z,m_t
+  ENDIF
+!-
+! Initialize the x-y indices
+!-
+  IF (    PRESENT(x_axis)    &
+ &    .OR.PRESENT(x_axis_2d) &
+ &    .OR.PRESENT(y_axis_2d) ) THEN
+    IF (PRESENT(x_start)) THEN
+      i_x = x_start
+    ELSE
+      i_x = 1
+    ENDIF
+    IF (PRESENT(x_count)) THEN
+      l_x = x_count
+    ELSE
+      l_x = m_x-i_x+1
+    ENDIF
+  ENDIF
+  IF (    PRESENT(y_axis)    &
+ &    .OR.PRESENT(y_axis_2d) &
+ &    .OR.PRESENT(x_axis_2d) ) THEN
+    IF (PRESENT(y_start)) THEN
+      i_y = y_start
+    ELSE
+      i_y = 1
+    ENDIF
+    IF (PRESENT(y_count)) THEN
+      l_y = y_count
+    ELSE
+      l_y = m_y-i_y+1
+    ENDIF
+  ENDIF
+  IF (PRESENT(x_axis)) THEN
+    IF (m_x <= 0) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'Requested x_axis', &
+ &      'but the coordinate is not present','in the file')
+    ELSE IF ((i_x+l_x-1) > m_x) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the x_axis', &
+ &      'is greater than the size of the coordinate','in the file')
+    ENDIF
+  ENDIF
+  IF (PRESENT(y_axis)) THEN
+    IF (m_y <= 0) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'Requested y_axis', &
+ &      'but the coordinate is not present','in the file')
+    ELSE IF ((i_y+l_y-1) > m_y) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the y_axis', &
+ &      'is greater than the size of the coordinate','in the file')
+    ENDIF
+  ENDIF
+  IF (PRESENT(x_axis_2d).OR.PRESENT(y_axis_2d) )THEN
+    IF ( (m_x <= 0).OR.(m_y <= 0) ) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'Requested [x/y]_axis_2d', &
+ &      'but the coordinates are not iboth present','in the file')
+    ELSE IF ( ((i_x+l_x-1) > m_x).OR.((i_y+l_y-1) > m_y) ) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the [x/y]_axis_2d', &
+ &      'is greater than the size of the coordinate','in the file')
+    ENDIF
+  ENDIF
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+! Extracting the x coordinate, if needed
+!-
+  IF (PRESENT(x_axis).OR.PRESENT(x_axis_2d)) THEN
+    CALL flio_qax (f_i,'x',i_v,nbdim)
+    IF (i_v > 0) THEN
+      IF      (nbdim == 1) THEN
+        IF (PRESENT(x_axis)) THEN
+          i_rc = NF90_GET_VAR(f_e,i_v,x_axis, &
+ &                 start=(/i_x/),count=(/l_x/))
+        ELSE
+          ALLOCATE(v_tmp(l_x))
+          i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                 start=(/i_x/),count=(/l_x/))
+          DO kv=1,l_y
+            x_axis_2d(:,kv) = v_tmp(:)
+          ENDDO
+          DEALLOCATE(v_tmp)
+        ENDIF
+      ELSE IF (nbdim == 2) THEN
+        IF (PRESENT(x_axis)) THEN
+          l_ok = .TRUE.
+          IF (l_y > 1) THEN
+            ALLOCATE(v_tmp(l_y))
+            DO kv=i_x,i_x+l_x-1
+              i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                     start=(/kv,i_y/),count=(/1,l_y/))
+              IF (ANY(v_tmp(2:l_y) /= v_tmp(1))) THEN
+                l_ok = .FALSE.
+                EXIT
+              ENDIF
+            ENDDO
+            DEALLOCATE(v_tmp)
+          ENDIF
+          IF (l_ok) THEN
+            i_rc = NF90_GET_VAR(f_e,i_v,x_axis, &
+ &                   start=(/i_x,i_y/),count=(/l_x,1/))
+          ELSE
+            CALL ipslerr (3,'fliogstc', &
+ &            'Requested 1D x_axis', &
+ &            'which have 2 not regular dimensions', &
+ &            'in the file')
+          ENDIF
+        ELSE
+          i_rc = NF90_GET_VAR(f_e,i_v,x_axis_2d, &
+ &                 start=(/i_x,i_y/),count=(/l_x,l_y/))
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'fliogstc', &
+ &        'Can not handle x_axis', &
+ &        'that have more than 2 dimensions', &
+ &        'in the file')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliogstc','No x_axis found','in the file',' ')
+    ENDIF
+  ENDIF
+!-
+! Extracting the y coordinate, if needed
+!-
+  IF (PRESENT(y_axis).OR.PRESENT(y_axis_2d)) THEN
+    CALL flio_qax (f_i,'y',i_v,nbdim)
+    IF (i_v > 0) THEN
+      IF      (nbdim == 1) THEN
+        IF (PRESENT(y_axis)) THEN
+          i_rc = NF90_GET_VAR(f_e,i_v,y_axis, &
+ &                 start=(/i_y/),count=(/l_y/))
+        ELSE
+          ALLOCATE(v_tmp(l_y))
+          i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                 start=(/i_y/),count=(/l_y/))
+          DO kv=1,l_x
+            y_axis_2d(kv,:) = v_tmp(:)
+          ENDDO
+          DEALLOCATE(v_tmp)
+        ENDIF
+      ELSE IF (nbdim == 2) THEN
+        IF (PRESENT(y_axis)) THEN
+          l_ok = .TRUE.
+          IF (l_x > 1) THEN
+            ALLOCATE(v_tmp(l_x))
+            DO kv=i_y,i_y+l_y-1
+              i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &                     start=(/i_x,kv/),count=(/l_x,1/))
+              IF (ANY(v_tmp(2:l_x) /= v_tmp(1))) THEN
+                l_ok = .FALSE.
+                EXIT
+              ENDIF
+            ENDDO
+            DEALLOCATE(v_tmp)
+          ENDIF
+          IF (l_ok) THEN
+            i_rc = NF90_GET_VAR(f_e,i_v,y_axis, &
+ &                   start=(/i_x,i_y/),count=(/1,l_y/))
+          ELSE
+            CALL ipslerr (3,'fliogstc', &
+ &            'Requested 1D y_axis', &
+ &            'which have 2 not regular dimensions', &
+ &            'in the file')
+          ENDIF
+        ELSE
+          i_rc = NF90_GET_VAR(f_e,i_v,y_axis_2d, &
+ &                 start=(/i_x,i_y/),count=(/l_x,l_y/))
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'fliogstc', &
+ &        'Can not handle y axis', &
+ &        'that have more than 2 dimensions', &
+ &        'in the file')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliogstc','No y_axis found','in the file',' ')
+    ENDIF
+  ENDIF
+!-
+! Extracting the z coordinate, if needed
+!-
+  IF (PRESENT(z_axis)) THEN
+    IF (PRESENT(z_start)) THEN
+      i_z = z_start
+    ELSE
+      i_z = 1
+    ENDIF
+    IF (PRESENT(z_count)) THEN
+      l_z = z_count
+    ELSE
+      l_z = m_z-i_z+1
+    ENDIF
+    IF ((i_z+l_z-1) > m_z) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the z axis', &
+ &      'is greater than the size of the coordinate',&
+ &      'in the file')
+    ENDIF
+    CALL flio_qax (f_i,'z',i_v,nbdim)
+    IF (i_v > 0) THEN
+      IF (nbdim == 1) THEN
+        i_rc = NF90_GET_VAR(f_e,i_v,z_axis, &
+ &               start=(/i_z/),count=(/l_z/))
+      ELSE
+        CALL ipslerr (3,'fliogstc', &
+ &        'Can not handle z_axis', &
+ &        'that have more than 1 dimension', &
+ &        'in the file')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'fliogstc','No z_axis found','in the file',' ')
+    ENDIF
+  ENDIF
+!-
+! Extracting the t coordinate, if needed
+!-
+  IF (PRESENT(t_axis).OR.PRESENT(t_init).OR.PRESENT(t_step)) THEN
+    CALL flio_qax (f_i,'t',i_v,nbdim)
+    IF (i_v < 0) THEN
+      CALL ipslerr (3,'fliogstc','No t_axis found','in the file',' ')
+    ENDIF
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliogstc - get time details'
+    ENDIF
+!---
+!-- Get all the details for the time
+!-- Prefered method is '"time_steps" since'
+!---
+    name=''
+    i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,name=name)
+    units=''
+    i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
+    IF      (INDEX(units,' since ') > 0) THEN
+      it_t = 1
+    ELSE IF (INDEX(name,'tstep') > 0) THEN
+      it_t = 2
+    ELSE
+      it_t = 0;
+    ENDIF
+  ENDIF
+!-
+! Extracting the t coordinate, if needed
+!-
+  IF (PRESENT(t_axis)) THEN
+    IF (PRESENT(t_start)) THEN
+      i_t = t_start
+    ELSE
+      i_t = 1
+    ENDIF
+    IF (PRESENT(t_count)) THEN
+      l_t = t_count
+    ELSE
+      l_t = m_t-i_t+1
+    ENDIF
+    IF ((i_t+l_t-1) > m_t) THEN
+      CALL ipslerr (3,'fliogstc', &
+ &      'The requested size for the t axis', &
+ &      'is greater than the size of the coordinate',&
+ &      'in the file')
+    ENDIF
+    ALLOCATE(v_tmp(l_t))
+    i_rc = NF90_GET_VAR(f_e,i_v,v_tmp, &
+ &           start=(/i_t/),count=(/l_t/))
+    t_axis(1:l_t) = NINT(v_tmp(1:l_t))
+    DEALLOCATE(v_tmp)
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliogstc - first time : ',t_axis(1:1)
+    ENDIF
+  ENDIF
+!-
+! Extracting the time at the beginning, if needed
+!-
+  IF (PRESENT(t_init)) THEN
+!-- Find the calendar
+    CALL lock_calendar (old_status=l_tmp)
+    CALL ioget_calendar (c_tmp)
+    units = ''
+    i_rc = NF90_GET_ATT(f_e,i_v,'calendar',units)
+    IF (i_rc == NF90_NOERR) THEN
+      CALL lock_calendar (new_status=.FALSE.)
+      CALL ioconf_calendar (TRIM(units))
+    ENDIF
+    IF (it_t == 1) THEN
+      units = ''
+      i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
+      units = units(INDEX(units,' since ')+7:LEN_TRIM(units))
+      READ (units,'(I4.4,5(A,I2.2))') &
+ &      j_yy,c_1,j_mo,c_1,j_dd,c_1,j_hh,c_1,j_mn,c_1,j_ss
+      r_ss = j_hh*3600.+j_mn*60.+j_ss
+      CALL ymds2ju (j_yy,j_mo,j_dd,r_ss,t_init)
+    ELSE IF (it_t == 2) THEN
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'year0',r_yy)
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'month0',r_mo)
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'day0',r_dd)
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'sec0',r_ss)
+      j_yy = NINT(r_yy); j_mo = NINT(r_mo); j_dd = NINT(r_dd);
+      CALL ymds2ju (j_yy,j_mo,j_dd,r_ss,t_init)
+    ELSE
+      t_init = 0.
+    ENDIF
+    CALL lock_calendar (new_status=.FALSE.)
+    CALL ioconf_calendar (TRIM(c_tmp))
+    CALL lock_calendar (new_status=l_tmp)
+    IF (l_dbg) THEN
+      WRITE(*,*) '  fliogstc - time_type : '
+      WRITE(*,*) it_t
+      WRITE(*,*) '  fliogstc - year month day second t_init : '
+      WRITE(*,*) j_yy,j_mo,j_dd,r_ss,t_init
+    ENDIF
+  ENDIF
+!-
+! Extracting the timestep in seconds, if needed
+!-
+  IF (PRESENT(t_step)) THEN
+    IF      (it_t == 1) THEN
+      units = ''
+      i_rc = NF90_GET_ATT(f_e,i_v,'units',units)
+      units = ADJUSTL(units(1:INDEX(units,' since ')-1))
+      dtn = 1.
+      IF      (INDEX(units,"week") /= 0) THEN
+        kv  = INDEX(units,"week")
+        dtv = 604800.
+      ELSE IF (INDEX(units,"day")  /= 0) THEN
+        kv  = INDEX(units,"day")
+        dtv = 86400.
+      ELSE IF (INDEX(units,"h")    /= 0) THEN
+        kv  = INDEX(units,"h")
+        dtv = 3600.
+      ELSE IF (INDEX(units,"min")  /= 0) THEN
+        kv  = INDEX(units,"min")
+        dtv = 60.
+      ELSE IF (INDEX(units,"sec")  /= 0) THEN
+        kv  = INDEX(units,"sec")
+        dtv = 1.
+      ELSE IF (INDEX(units,"timesteps") /= 0) THEN
+        kv  = INDEX(units,"timesteps")
+        i_rc = NF90_GET_ATT(f_e,i_v,'tstep_sec',dtv)
+        IF (i_rc /= NF90_NOERR) THEN
+          CALL ipslerr (3,'fliogstc','"timesteps" value', &
+ &                        'not found','in the file')
+        ENDIF
+      ELSE
+        kv  = 1
+        dtv = 1.
+      ENDIF
+      IF (kv > 1) THEN
+        READ (unit=units(1:kv-1),FMT=*) dtn
+      ENDIF
+      t_step = dtn*dtv
+    ELSE IF (it_t == 2) THEN
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,'delta_tstep_sec',t_step)
+    ELSE
+      t_step = 1.
+    ENDIF
+  ENDIF
+!-
+! Extracting the calendar attribute, if needed
+!-
+  IF (PRESENT(t_calendar)) THEN
+    units = ''
+    i_rc = NF90_GET_ATT(f_e,i_v,'calendar',units)
+    IF (i_rc == NF90_NOERR) THEN
+      t_calendar = units
+    ELSE
+      t_calendar = "not found"
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliogstc"
+  ENDIF
+!----------------------
+END SUBROUTINE fliogstc
+!===
+SUBROUTINE flioinqv &
+ & (f_i,v_n,l_ex,v_t,nb_dims,len_dims,id_dims, &
+ &  nb_atts,cn_atts,ia_start,ia_count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  LOGICAL,INTENT(OUT) :: l_ex
+  INTEGER,OPTIONAL,INTENT(OUT) :: v_t,nb_dims,nb_atts
+  INTEGER,OPTIONAL,INTENT(OUT),DIMENSION(:) :: len_dims,id_dims
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cn_atts
+  INTEGER,OPTIONAL,INTENT(IN) :: ia_start,ia_count
+!-
+  INTEGER :: f_e,i_v,n_w,i_s,i_w,iws,iwc,i_rc
+  LOGICAL :: l_ok
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: dim_ids
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqv ",TRIM(v_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioinqv',f_i,f_e)
+!-
+  i_v = -1
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+!-
+  l_ex = ( (i_v >= 0).AND.(i_rc == NF90_NOERR) )
+!-
+  IF (l_ex) THEN
+    IF (PRESENT(v_t)) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,xtype=v_t)
+    ENDIF
+    n_w = -1
+    IF (PRESENT(nb_dims).OR.PRESENT(len_dims)) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v, &
+ &             ndims=n_w,dimids=dim_ids)
+      IF (PRESENT(nb_dims)) THEN
+        nb_dims = n_w
+      ENDIF
+      IF (PRESENT(len_dims)) THEN
+        i_s = SIZE(len_dims)
+        len_dims(:) = -1
+        IF (i_s < n_w) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'Only the first dimensions of the variable', &
+ &         TRIM(v_n),'will be returned')
+        ENDIF
+        DO i_w=1,MIN(n_w,i_s)
+          i_rc = NF90_INQUIRE_DIMENSION(f_e,dim_ids(i_w), &
+ &                                      len=len_dims(i_w))
+        ENDDO
+      ENDIF
+      IF (PRESENT(id_dims)) THEN
+        i_s = SIZE(id_dims)
+        id_dims(:) = -1
+        IF (i_s < n_w) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of dimensions to retrieve', &
+ &         'is greater than the size of the array,', &
+ &         'only the first dimensions of "' &
+ &           //TRIM(v_n)//'" will be returned')
+        ENDIF
+        i_w = MIN(n_w,i_s)
+        id_dims(1:i_w) = dim_ids(1:i_w)
+      ENDIF
+    ENDIF
+    IF (PRESENT(nb_atts).OR.PRESENT(cn_atts)) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,i_v,nAtts=n_w)
+      IF (PRESENT(nb_atts)) THEN
+        nb_atts = n_w
+      ENDIF
+      IF (PRESENT(cn_atts)) THEN
+        l_ok = .TRUE.
+        i_s = SIZE(cn_atts)
+        DO i_w=1,i_s
+          cn_atts(i_w)(:) = '?'
+        ENDDO
+        IF (PRESENT(ia_start)) THEN
+          iws = ia_start
+        ELSE
+          iws = 1
+        ENDIF
+        IF (PRESENT(ia_count)) THEN
+          iwc = ia_count
+        ELSE
+          iwc = n_w
+        ENDIF
+        IF (iws > n_w) THEN
+          l_ok = .FALSE.
+          CALL ipslerr (2,'flioinqv', &
+ &         'The start index of requested attributes', &
+ &         'is greater than the number of attributes of', &
+ &         '"'//TRIM(v_n)//'"')
+        ELSE IF (iws < 1) THEN
+          l_ok = .FALSE.
+          CALL ipslerr (2,'flioinqv', &
+ &         'The start index of requested attributes', &
+ &         'is invalid ( < 1 ) for', &
+ &         '"'//TRIM(v_n)//'"')
+        ENDIF
+        IF ((iws+iwc-1) > n_w) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of requested attributes', &
+ &         'is greater than the number of attributes of', &
+ &         '"'//TRIM(v_n)//'"')
+        ENDIF
+        IF (iwc > i_s) THEN
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of attributes to retrieve', &
+ &         'is greater than the size of the array,', &
+ &         'only the first attributes of "' &
+ &           //TRIM(v_n)//'" will be returned')
+        ELSE IF (iwc < 1) THEN
+          l_ok = .FALSE.
+          CALL ipslerr (2,'flioinqv', &
+ &         'The number of requested attributes', &
+ &         'is invalid ( < 1 ) for', &
+ &         '"'//TRIM(v_n)//'"')
+        ENDIF
+        IF (l_ok) THEN
+          DO i_w=1,MIN(iwc,i_s,n_w-iws+1)
+            i_rc = NF90_INQ_ATTNAME(f_e, &
+ &                  i_v,i_w+iws-1,name=cn_atts(i_w))
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqv"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqv
+!===
+SUBROUTINE fliogv_i40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_i40
+!===
+SUBROUTINE fliogv_i41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i41
+!===
+SUBROUTINE fliogv_i42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i42
+!===
+SUBROUTINE fliogv_i43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i43
+!===
+SUBROUTINE fliogv_i44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i44
+!===
+SUBROUTINE fliogv_i45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i45
+!===
+SUBROUTINE fliogv_i20 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_20=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_i20
+!===
+SUBROUTINE fliogv_i21 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_21=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i21
+!===
+SUBROUTINE fliogv_i22 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_22=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i22
+!===
+SUBROUTINE fliogv_i23 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_23=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i23
+!===
+SUBROUTINE fliogv_i24 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_24=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i24
+!===
+SUBROUTINE fliogv_i25 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,i_25=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_i25
+!===
+!?INTEGERS of KIND 1 are not supported on all computers
+!?SUBROUTINE fliogv_i10 (f_i,v_n,v_v,start)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_10=v_v,start=start)
+!?!------------------------
+!?END SUBROUTINE fliogv_i10
+!?!===
+!?SUBROUTINE fliogv_i11 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_11=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i11
+!?!===
+!?SUBROUTINE fliogv_i12 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_12=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i12
+!?!===
+!?SUBROUTINE fliogv_i13 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_13=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i13
+!?!===
+!?SUBROUTINE fliogv_i14 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_14=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i14
+!?!===
+!?SUBROUTINE fliogv_i15 (f_i,v_n,v_v,start,count)
+!?!---------------------------------------------------------------------
+!?  IMPLICIT NONE
+!?!-
+!?  INTEGER,INTENT(IN) :: f_i
+!?  CHARACTER(LEN=*),INTENT(IN) :: v_n
+!?  INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+!?  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!?!---------------------------------------------------------------------
+!?  CALL flio_ugv (f_i,v_n,i_15=v_v,start=start,count=count)
+!?!------------------------
+!?END SUBROUTINE fliogv_i15
+!===
+SUBROUTINE fliogv_r40 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_40=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_r40
+!===
+SUBROUTINE fliogv_r41 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_41=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r41
+!===
+SUBROUTINE fliogv_r42 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_42=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r42
+!===
+SUBROUTINE fliogv_r43 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_43=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r43
+!===
+SUBROUTINE fliogv_r44 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_44=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r44
+!===
+SUBROUTINE fliogv_r45 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_45=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r45
+!===
+SUBROUTINE fliogv_r80 (f_i,v_n,v_v,start)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_80=v_v,start=start)
+!------------------------
+END SUBROUTINE fliogv_r80
+!===
+SUBROUTINE fliogv_r81 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_81=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r81
+!===
+SUBROUTINE fliogv_r82 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_82=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r82
+!===
+SUBROUTINE fliogv_r83 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_83=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r83
+!===
+SUBROUTINE fliogv_r84 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_84=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r84
+!===
+SUBROUTINE fliogv_r85 (f_i,v_n,v_v,start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(OUT) :: v_v
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(IN) :: start,count
+!---------------------------------------------------------------------
+  CALL flio_ugv (f_i,v_n,r_85=v_v,start=start,count=count)
+!------------------------
+END SUBROUTINE fliogv_r85
+!===
+SUBROUTINE flio_ugv &
+ & (f_i,v_n, &
+ &  i_40,i_41,i_42,i_43,i_44,i_45, &
+ &  i_20,i_21,i_22,i_23,i_24,i_25, &
+!? &  i_10,i_11,i_12,i_13,i_14,i_15, &
+ &  r_40,r_41,r_42,r_43,r_44,r_45, &
+ &  r_80,r_81,r_82,r_83,r_84,r_85, &
+ &  start,count)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n
+  INTEGER(KIND=i_4),INTENT(OUT),OPTIONAL :: i_40
+  INTEGER(KIND=i_4),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_41
+  INTEGER(KIND=i_4),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_42
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_43
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_44
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_45
+  INTEGER(KIND=i_2),INTENT(OUT),OPTIONAL :: i_20
+  INTEGER(KIND=i_2),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_21
+  INTEGER(KIND=i_2),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_22
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_23
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_24
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_25
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1),INTENT(OUT),OPTIONAL :: i_10
+!?INTEGER(KIND=i_1),DIMENSION(:),INTENT(OUT),OPTIONAL :: i_11
+!?INTEGER(KIND=i_1),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: i_12
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: i_13
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: i_14
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: i_15
+  REAL(KIND=r_4),INTENT(OUT),OPTIONAL :: r_40
+  REAL(KIND=r_4),DIMENSION(:),INTENT(OUT),OPTIONAL :: r_41
+  REAL(KIND=r_4),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: r_42
+  REAL(KIND=r_4),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: r_43
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: r_44
+  REAL(KIND=r_4),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: r_45
+  REAL(KIND=r_8),INTENT(OUT),OPTIONAL :: r_80
+  REAL(KIND=r_8),DIMENSION(:),INTENT(OUT),OPTIONAL :: r_81
+  REAL(KIND=r_8),DIMENSION(:,:),INTENT(OUT),OPTIONAL :: r_82
+  REAL(KIND=r_8),DIMENSION(:,:,:),INTENT(OUT),OPTIONAL :: r_83
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),INTENT(OUT),OPTIONAL :: r_84
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),INTENT(OUT),OPTIONAL :: r_85
+  INTEGER,DIMENSION(:),INTENT(IN),OPTIONAL :: start,count
+!-
+  INTEGER :: f_e,i_v,i_rc
+  CHARACTER(LEN=5) :: cvr_d
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    IF      (PRESENT(i_40)) THEN; cvr_d = "I1 0D";
+    ELSE IF (PRESENT(i_41)) THEN; cvr_d = "I1 1D";
+    ELSE IF (PRESENT(i_42)) THEN; cvr_d = "I1 2D";
+    ELSE IF (PRESENT(i_43)) THEN; cvr_d = "I1 3D";
+    ELSE IF (PRESENT(i_44)) THEN; cvr_d = "I1 4D";
+    ELSE IF (PRESENT(i_45)) THEN; cvr_d = "I1 5D";
+    ELSE IF (PRESENT(i_20)) THEN; cvr_d = "I2 0D";
+    ELSE IF (PRESENT(i_21)) THEN; cvr_d = "I2 1D";
+    ELSE IF (PRESENT(i_22)) THEN; cvr_d = "I2 2D";
+    ELSE IF (PRESENT(i_23)) THEN; cvr_d = "I2 3D";
+    ELSE IF (PRESENT(i_24)) THEN; cvr_d = "I2 4D";
+    ELSE IF (PRESENT(i_25)) THEN; cvr_d = "I2 5D";
+!?  ELSE IF (PRESENT(i_10)) THEN; cvr_d = "I4 0D";
+!?  ELSE IF (PRESENT(i_11)) THEN; cvr_d = "I4 1D";
+!?  ELSE IF (PRESENT(i_12)) THEN; cvr_d = "I4 2D";
+!?  ELSE IF (PRESENT(i_13)) THEN; cvr_d = "I4 3D";
+!?  ELSE IF (PRESENT(i_14)) THEN; cvr_d = "I4 4D";
+!?  ELSE IF (PRESENT(i_15)) THEN; cvr_d = "I4 5D";
+    ELSE IF (PRESENT(r_40)) THEN; cvr_d = "R4 0D";
+    ELSE IF (PRESENT(r_41)) THEN; cvr_d = "R4 1D";
+    ELSE IF (PRESENT(r_42)) THEN; cvr_d = "R4 2D";
+    ELSE IF (PRESENT(r_43)) THEN; cvr_d = "R4 3D";
+    ELSE IF (PRESENT(r_44)) THEN; cvr_d = "R4 4D";
+    ELSE IF (PRESENT(r_45)) THEN; cvr_d = "R4 5D";
+    ELSE IF (PRESENT(r_80)) THEN; cvr_d = "R8 0D";
+    ELSE IF (PRESENT(r_81)) THEN; cvr_d = "R8 1D";
+    ELSE IF (PRESENT(r_82)) THEN; cvr_d = "R8 2D";
+    ELSE IF (PRESENT(r_83)) THEN; cvr_d = "R8 3D";
+    ELSE IF (PRESENT(r_84)) THEN; cvr_d = "R8 4D";
+    ELSE IF (PRESENT(r_85)) THEN; cvr_d = "R8 5D";
+    ENDIF
+    WRITE(*,*) "->fliogetv ",TRIM(v_n)," ",TRIM(cvr_d)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliogetv',f_i,f_e)
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+  IF (i_rc == NF90_NOERR) THEN
+    IF      (PRESENT(i_40)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_40,start=start)
+    ELSE IF (PRESENT(i_41)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_41,start=start,count=count)
+    ELSE IF (PRESENT(i_42)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_42,start=start,count=count)
+    ELSE IF (PRESENT(i_43)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_43,start=start,count=count)
+    ELSE IF (PRESENT(i_44)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_44,start=start,count=count)
+    ELSE IF (PRESENT(i_45)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_45,start=start,count=count)
+    ELSE IF (PRESENT(i_20)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_20,start=start)
+    ELSE IF (PRESENT(i_21)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_21,start=start,count=count)
+    ELSE IF (PRESENT(i_22)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_22,start=start,count=count)
+    ELSE IF (PRESENT(i_23)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_23,start=start,count=count)
+    ELSE IF (PRESENT(i_24)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_24,start=start,count=count)
+    ELSE IF (PRESENT(i_25)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,i_25,start=start,count=count)
+!?  ELSE IF (PRESENT(i_10)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_10,start=start)
+!?  ELSE IF (PRESENT(i_11)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_11,start=start,count=count)
+!?  ELSE IF (PRESENT(i_12)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_12,start=start,count=count)
+!?  ELSE IF (PRESENT(i_13)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_13,start=start,count=count)
+!?  ELSE IF (PRESENT(i_14)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_14,start=start,count=count)
+!?  ELSE IF (PRESENT(i_15)) THEN
+!?    i_rc = NF90_GET_VAR(f_e,i_v,i_15,start=start,count=count)
+    ELSE IF (PRESENT(r_40)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_40,start=start)
+    ELSE IF (PRESENT(r_41)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_41,start=start,count=count)
+    ELSE IF (PRESENT(r_42)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_42,start=start,count=count)
+    ELSE IF (PRESENT(r_43)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_43,start=start,count=count)
+    ELSE IF (PRESENT(r_44)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_44,start=start,count=count)
+    ELSE IF (PRESENT(r_45)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_45,start=start,count=count)
+    ELSE IF (PRESENT(r_80)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_80,start=start)
+    ELSE IF (PRESENT(r_81)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_81,start=start,count=count)
+    ELSE IF (PRESENT(r_82)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_82,start=start,count=count)
+    ELSE IF (PRESENT(r_83)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_83,start=start,count=count)
+    ELSE IF (PRESENT(r_84)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_84,start=start,count=count)
+    ELSE IF (PRESENT(r_85)) THEN
+      i_rc = NF90_GET_VAR(f_e,i_v,r_85,start=start,count=count)
+    ENDIF
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliogetv', &
+ &      'Variable '//TRIM(v_n)//' not get','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+  ELSE
+    CALL ipslerr (3,'fliogetv','Variable',TRIM(v_n),'not found')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliogetv"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_ugv
+!===
+SUBROUTINE flioinqa (f_i,v_n,a_n,l_ex,a_t,a_l)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  LOGICAL,INTENT(OUT) :: l_ex
+  INTEGER,OPTIONAL,INTENT(OUT) :: a_t,a_l
+!-
+  INTEGER :: i_rc,f_e,i_v,t_ea,l_ea
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioinqa ",TRIM(v_n),"-",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioinqa',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'flioinqa', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,xtype=t_ea,len=l_ea)
+!-
+  l_ex = (i_rc == NF90_NOERR)
+!-
+  IF (l_ex) THEN
+    IF (PRESENT(a_t)) THEN
+      a_t = t_ea
+    ENDIF
+    IF (PRESENT(a_l)) THEN
+      a_l = l_ea
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioinqa"
+  ENDIF
+!----------------------
+END SUBROUTINE flioinqa
+!===
+SUBROUTINE flioga_r4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_4_0=a_v)
+!---------------------------
+END SUBROUTINE flioga_r4_0d
+!===
+SUBROUTINE flioga_r4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),DIMENSION(:),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_4_1=a_v)
+!--------------------------
+END SUBROUTINE flioga_r4_1d
+!===
+SUBROUTINE flioga_r8_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_8_0=a_v)
+!---------------------------
+END SUBROUTINE flioga_r8_0d
+!===
+SUBROUTINE flioga_r8_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=8),DIMENSION(:),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avr_8_1=a_v)
+!--------------------------
+END SUBROUTINE flioga_r8_1d
+!===
+SUBROUTINE flioga_i4_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avi_4_0=a_v)
+!---------------------------
+END SUBROUTINE flioga_i4_0d
+!===
+SUBROUTINE flioga_i4_1d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  INTEGER(KIND=4),DIMENSION(:),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avi_4_1=a_v)
+!--------------------------
+END SUBROUTINE flioga_i4_1d
+!===
+SUBROUTINE flioga_tx_0d (f_i,v_n,a_n,a_v)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  CHARACTER(LEN=*),INTENT(OUT) :: a_v
+!---------------------------------------------------------------------
+  CALL flio_uga (f_i,v_n,a_n,avtx=a_v)
+!---------------------------
+END SUBROUTINE flioga_tx_0d
+!===
+SUBROUTINE flio_uga &
+ & (f_i,v_n,a_n, &
+ &  avr_4_0,avr_4_1,avr_8_0,avr_8_1,avi_4_0,avi_4_1,avtx)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+  REAL(KIND=4),OPTIONAL,INTENT(OUT) :: avr_4_0
+  REAL(KIND=4),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avr_4_1
+  REAL(KIND=8),OPTIONAL,INTENT(OUT) :: avr_8_0
+  REAL(KIND=8),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avr_8_1
+  INTEGER(KIND=4),OPTIONAL,INTENT(OUT) :: avi_4_0
+  INTEGER(KIND=4),DIMENSION(:),OPTIONAL,INTENT(OUT) :: avi_4_1
+  CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: avtx
+!-
+  INTEGER :: f_e,l_ua,i_v,t_ea,l_ea,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliogeta ",TRIM(v_n)," ",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliogeta',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliogeta', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,xtype=t_ea,len=l_ea)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliogeta', &
+ &   'Attribute :',TRIM(a_n),'not found')
+  ENDIF
+!-
+  IF ( (.NOT.PRESENT(avtx).AND.(t_ea == NF90_CHAR)) &
+ &      .OR.(PRESENT(avtx).AND.(t_ea /= NF90_CHAR)) ) THEN
+    CALL ipslerr (3,'fliogeta', &
+ &   'The external type of the attribute :',TRIM(a_n), &
+ &   'is not compatible with the type of the argument')
+  ENDIF
+!-
+  IF      (PRESENT(avr_4_1)) THEN
+    l_ua = SIZE(avr_4_1)
+  ELSE IF (PRESENT(avr_8_1)) THEN
+    l_ua = SIZE(avr_8_1)
+  ELSE IF (PRESENT(avi_4_1)) THEN
+    l_ua = SIZE(avi_4_1)
+  ELSE IF (PRESENT(avtx)) THEN
+    l_ua = LEN(avtx)
+  ELSE
+    l_ua = 1
+  ENDIF
+!-
+  IF (l_ua < l_ea) THEN
+    CALL ipslerr (3,'fliogeta', &
+     'Insufficient size of the argument', &
+ &   'to receive the values of the attribute :',TRIM(a_n))
+  ENDIF
+!-
+  IF      (PRESENT(avr_4_0)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_4_0)
+  ELSE IF (PRESENT(avr_4_1)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_4_1(1:l_ea))
+  ELSE IF (PRESENT(avr_8_0)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_8_0)
+  ELSE IF (PRESENT(avr_8_1)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avr_8_1(1:l_ea))
+  ELSE IF (PRESENT(avi_4_0)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avi_4_0)
+  ELSE IF (PRESENT(avi_4_1)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avi_4_1(1:l_ea))
+  ELSE IF (PRESENT(avtx)) THEN
+    i_rc = NF90_GET_ATT(f_e,i_v,a_n,avtx)
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliogeta"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_uga
+!===
+SUBROUTINE fliorenv (f_i,v_o_n,v_n_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_o_n,v_n_n
+!-
+  INTEGER :: f_e,i_v,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    "->fliorenv ",TRIM(v_o_n),"->",TRIM(v_n_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliorenv',f_i,f_e)
+!-
+  i_rc = NF90_INQ_VARID(f_e,v_o_n,i_v)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (2,'fliorenv', &
+     'Variable :',TRIM(v_o_n),'not found')
+  ELSE
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_RENAME_VAR(f_e,i_v,v_n_n)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (2,'fliorenv', &
+       'Variable :',TRIM(v_o_n),'can not be renamed')
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliorenv"
+  ENDIF
+!----------------------
+END SUBROUTINE fliorenv
+!===
+SUBROUTINE fliorena (f_i,v_n,a_o_n,a_n_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_o_n,a_n_n
+!-
+  INTEGER :: f_e,i_v,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    "->fliorena ",TRIM(v_n),"-",TRIM(a_o_n),"->",TRIM(a_n_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliorena',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliorena', &
+       'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_o_n,attnum=i_a)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (2,'fliorena', &
+     'Attribute :',TRIM(a_o_n),'not found')
+  ELSE
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_RENAME_ATT(f_e,i_v,a_o_n,a_n_n)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (2,'fliorena', &
+       'Attribute :',TRIM(a_o_n),'can not be renamed')
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliorena"
+  ENDIF
+!----------------------
+END SUBROUTINE fliorena
+!===
+SUBROUTINE fliodela (f_i,v_n,a_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: v_n,a_n
+!-
+  INTEGER :: f_e,i_v,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliodela ",TRIM(v_n),"-",TRIM(a_n)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliodela',f_i,f_e)
+!-
+  IF (TRIM(v_n) == '?') THEN
+    i_v = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e,v_n,i_v)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliodela', &
+ &     'Variable :',TRIM(v_n),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_v,a_n,attnum=i_a)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (2,'fliodela', &
+ &   'Attribute :',TRIM(a_n),'not found')
+  ELSE
+    IF (i_v == NF90_GLOBAL) THEN
+      nw_na(f_i) = nw_na(f_i)-1
+    ENDIF
+    CALL flio_hdm (f_i,f_e,.TRUE.)
+    i_rc = NF90_DEL_ATT(f_e,i_v,a_n)
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliodela"
+  ENDIF
+!----------------------
+END SUBROUTINE fliodela
+!===
+SUBROUTINE fliocpya (f_i_i,v_n_i,a_n,f_i_o,v_n_o)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i_i,f_i_o
+  CHARACTER(LEN=*),INTENT(IN) :: v_n_i,a_n,v_n_o
+!-
+  INTEGER :: f_e_i,f_e_o,i_v_i,i_v_o,i_a,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliocpya - file",f_i_i,"-",TRIM(v_n_i),"-",TRIM(a_n)
+    WRITE(*,*) "  copied to file ",f_i_o,"-",TRIM(v_n_o)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('fliocpya',f_i_i,f_e_i)
+  CALL flio_qvid ('fliocpya',f_i_o,f_e_o)
+!-
+  IF (TRIM(v_n_i) == '?') THEN
+    i_v_i = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e_i,v_n_i,i_v_i)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliocpya', &
+ &     'Variable :',TRIM(v_n_i),'not found')
+    ENDIF
+  ENDIF
+!-
+  IF (TRIM(v_n_o) == '?') THEN
+    i_v_o = NF90_GLOBAL
+  ELSE
+    i_rc = NF90_INQ_VARID(f_e_o,v_n_o,i_v_o)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliocpya', &
+ &     'Variable :',TRIM(v_n_o),'not found')
+    ENDIF
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE_ATTRIBUTE(f_e_i,i_v_i,a_n,attnum=i_a)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliocpya', &
+     'Attribute :',TRIM(a_n),'not found')
+  ELSE
+    i_rc = NF90_INQUIRE_ATTRIBUTE(f_e_o,i_v_o,a_n,attnum=i_a)
+    IF ( (i_v_o == NF90_GLOBAL).AND.(i_rc /= NF90_NOERR) ) THEN
+      nw_na(f_i_o) = nw_na(f_i_o)+1
+    ENDIF
+    CALL flio_hdm (f_i_o,f_e_o,.TRUE.)
+    i_rc = NF90_COPY_ATT(f_e_i,i_v_i,a_n,f_e_o,i_v_o)
+    IF (i_rc /= NF90_NOERR) THEN
+      CALL ipslerr (3,'fliocpya', &
+ &      'Attribute '//TRIM(a_n)//' not copied','Error :', &
+ &      TRIM(NF90_STRERROR(i_rc)))
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliocpya"
+  ENDIF
+!----------------------
+END SUBROUTINE fliocpya
+!===
+SUBROUTINE flioqstc (f_i,c_type,l_ex,c_name)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i
+  CHARACTER(LEN=*),INTENT(IN) :: c_type
+  LOGICAL,INTENT(OUT) :: l_ex
+  CHARACTER(LEN=*),INTENT(OUT) :: c_name
+!-
+  CHARACTER(LEN=1) :: c_ax
+  INTEGER :: f_e,idc,ndc,i_rc
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioqstc ",TRIM(c_type)
+  ENDIF
+!-
+! Retrieve the external file index
+  CALL flio_qvid ('flioqstc',f_i,f_e)
+!-
+  c_ax = TRIM(c_type)
+  IF (    (LEN_TRIM(c_type) == 1) &
+ &    .AND.(    (c_ax == 'x').OR.(c_ax == 'y') &
+ &          .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
+    CALL flio_qax (f_i,c_ax,idc,ndc)
+    l_ex = (idc > 0)
+    IF (l_ex) THEN
+      i_rc = NF90_INQUIRE_VARIABLE(f_e,idc,name=c_name)
+    ENDIF
+  ELSE
+    l_ex = .FALSE.
+    CALL ipslerr (2,'flioqstc', &
+ &   'The name of the coordinate,',TRIM(c_type),'is not valid')
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioqstc"
+  ENDIF
+!----------------------
+END SUBROUTINE flioqstc
+!===
+SUBROUTINE fliosync (f_i)
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in),OPTIONAL :: f_i
+!-
+  INTEGER :: i_f,f_e,i_rc,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->fliosync"
+  ENDIF
+!-
+  IF (PRESENT(f_i)) THEN
+    IF ( (f_i >= 1).AND.(f_i <= nb_fi_mx) ) THEN
+      i_s = f_i
+      i_e = f_i
+    ELSE
+      i_s = 1
+      i_e = 0
+      CALL ipslerr (2,'fliosync', &
+ &     'Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_fi_mx
+  ENDIF
+!-
+! Ensuring data mode
+!-
+  CALL flio_hdm (f_i,f_e,.FALSE.)
+!-
+  DO i_f=i_s,i_e
+    f_e = nw_id(i_f)
+    IF (f_e > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  fliosync - synchronising file number ',i_f
+      ENDIF
+      i_rc = NF90_SYNC(f_e)
+    ELSE IF (PRESENT(f_i)) THEN
+      CALL ipslerr (2,'fliosync', &
+ &     'Unable to synchronise the file :','probably','not opened')
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-fliosync"
+  ENDIF
+!----------------------
+END SUBROUTINE fliosync
+!===
+SUBROUTINE flioclo (f_i)
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in),OPTIONAL :: f_i
+!-
+  INTEGER :: i_f,f_e,i_rc,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flioclo"
+  ENDIF
+!-
+  IF (PRESENT(f_i)) THEN
+    IF ( (f_i >= 1).AND.(f_i <= nb_fi_mx) ) THEN
+      i_s = f_i
+      i_e = f_i
+    ELSE
+      i_s = 1
+      i_e = 0
+      CALL ipslerr (2,'flioclo', &
+ &     'Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_fi_mx
+  ENDIF
+!-
+  DO i_f=i_s,i_e
+    f_e = nw_id(i_f)
+    IF (f_e > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  flioclo - closing file number ',i_f
+      ENDIF
+      i_rc = NF90_CLOSE(f_e)
+      nw_id(i_f) = -1
+    ELSE IF (PRESENT(f_i)) THEN
+      CALL ipslerr (2,'flioclo', &
+ &     'Unable to close the file :','probably','not opened')
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flioclo"
+  ENDIF
+!---------------------
+END SUBROUTINE flioclo
+!===
+SUBROUTINE fliodmpf (f_n)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: f_n
+!-
+  INTEGER :: f_e,n_dims,n_vars,n_atts,i_unlm
+  INTEGER :: i_rc,i_n,k_n,t_ea,l_ea
+  INTEGER :: tmp_i
+  REAL    :: tmp_r
+  INTEGER,DIMENSION(:),ALLOCATABLE :: tma_i
+  REAL,DIMENSION(:),ALLOCATABLE    :: tma_r
+  CHARACTER(LEN=256) :: tmp_c
+  INTEGER,DIMENSION(nb_fd_mx) :: n_idim,n_ldim
+  INTEGER,DIMENSION(nb_ax_mx) :: n_ai
+  CHARACTER(LEN=NF90_MAX_NAME),DIMENSION(nb_fd_mx) :: c_ndim
+  INTEGER,DIMENSION(NF90_MAX_VAR_DIMS) :: idimid
+  CHARACTER(LEN=NF90_MAX_NAME) :: c_name
+!---------------------------------------------------------------------
+  i_rc = NF90_OPEN(TRIM(f_n),NF90_NOWRITE,f_e)
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'fliodmpf', &
+ &   'Could not open file :',TRIM(f_n), &
+ &   TRIM(NF90_STRERROR(i_rc))//' (Netcdf)')
+  ENDIF
+!-
+  WRITE (*,*) "---"
+  WRITE (*,*) "--- File '",TRIM(f_n),"'"
+  WRITE (*,*) "---"
+!-
+  CALL flio_inf &
+ &  (f_e,nb_dims=n_dims,nb_vars=n_vars, &
+ &       nb_atts=n_atts,id_unlm=i_unlm, &
+ &       nn_idm=n_idim,nn_ldm=n_ldim,cc_ndm=c_ndim,nn_aid=n_ai)
+!-
+  WRITE (*,*) 'External model identifier   : ',f_e
+  WRITE (*,*) 'Number of dimensions        : ',n_dims
+  WRITE (*,*) 'Number of variables         : ',n_vars
+  WRITE (*,*) 'ID unlimited                : ',i_unlm
+!-
+  WRITE (*,*) "---"
+  WRITE (*,*) 'Presumed axis dimensions identifiers :'
+  IF (n_ai(k_lon) > 0) THEN
+    WRITE (*,*) 'x axis : ',n_ai(k_lon)
+  ELSE
+    WRITE (*,*) 'x axis : NONE'
+  ENDIF
+  IF (n_ai(k_lat) > 0) THEN
+    WRITE (*,*) 'y axis : ',n_ai(k_lat)
+  ELSE
+    WRITE (*,*) 'y axis : NONE'
+  ENDIF
+  IF (n_ai(k_lev) > 0) THEN
+    WRITE (*,*) 'z axis : ',n_ai(k_lev)
+  ELSE
+    WRITE (*,*) 'z axis : NONE'
+  ENDIF
+  IF (n_ai(k_tim) > 0) THEN
+    WRITE (*,*) 't axis : ',n_ai(k_tim)
+  ELSE
+    WRITE (*,*) 't axis : NONE'
+  ENDIF
+!-
+  WRITE (*,*) "---"
+  WRITE (*,*) 'Number of global attributes : ',n_atts
+  DO k_n=1,n_atts
+    i_rc = NF90_INQ_ATTNAME(f_e,NF90_GLOBAL,k_n,c_name)
+    i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,NF90_GLOBAL,c_name, &
+ &                                xtype=t_ea,len=l_ea)
+    IF      (    (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
+             .OR.(t_ea == NF90_INT1) ) THEN
+      IF (l_ea > 1) THEN
+        ALLOCATE(tma_i(l_ea))
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_i)
+        WRITE (*,'("    ",A," :",/,(5(1X,I10),:))') &
+ &        TRIM(c_name),tma_i(1:l_ea)
+        DEALLOCATE(tma_i)
+      ELSE
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_i)
+        WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_i
+      ENDIF
+    ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
+      IF (l_ea > 1) THEN
+        ALLOCATE(tma_r(l_ea))
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tma_r)
+        WRITE (*,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
+ &        TRIM(c_name),tma_r(1:l_ea)
+        DEALLOCATE(tma_r)
+      ELSE
+        i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_r)
+        WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_r
+      ENDIF
+    ELSE
+      tmp_c = ''
+      i_rc = NF90_GET_ATT(f_e,NF90_GLOBAL,c_name,tmp_c)
+      WRITE(*,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
+    ENDIF
+  ENDDO
+!-
+  DO i_n=1,nb_fd_mx
+    IF (n_idim(i_n) > 0) THEN
+      WRITE (*,*) "---"
+      WRITE (*,*) 'Dimension id   : ',n_idim(i_n)
+      WRITE (*,*) 'Dimension name : ',TRIM(c_ndim(i_n))
+      WRITE (*,*) 'Dimension size : ',n_ldim(i_n)
+    ENDIF
+  ENDDO
+!-
+  DO i_n=1,n_vars
+    i_rc = NF90_INQUIRE_VARIABLE(f_e,i_n, &
+ &           name=c_name,ndims=n_dims,dimids=idimid,nAtts=n_atts)
+    WRITE (*,*) "---"
+    WRITE (*,*) "Variable name        : ",TRIM(c_name)
+    WRITE (*,*) "Variable identifier  : ",i_n
+    WRITE (*,*) "Number of dimensions : ",n_dims
+    IF (n_dims > 0) THEN
+      WRITE (*,*) "Dimensions ID's      : ",idimid(1:n_dims)
+    ENDIF
+    WRITE (*,*) "Number of attributes : ",n_atts
+    DO k_n=1,n_atts
+      i_rc = NF90_INQ_ATTNAME(f_e,i_n,k_n,c_name)
+      i_rc = NF90_INQUIRE_ATTRIBUTE(f_e,i_n,c_name, &
+ &                                  xtype=t_ea,len=l_ea)
+      IF      (    (t_ea == NF90_INT4).OR.(t_ea == NF90_INT2) &
+ &             .OR.(t_ea == NF90_INT1) ) THEN
+        IF (l_ea > 1) THEN
+          ALLOCATE(tma_i(l_ea))
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_i)
+          WRITE (*,'("    ",A," :",/,(5(1X,I10),:))') &
+ &              TRIM(c_name),tma_i(1:l_ea)
+          DEALLOCATE(tma_i)
+        ELSE
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_i)
+          WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_i
+        ENDIF
+      ELSE IF ( (t_ea == NF90_REAL4).OR.(t_ea == NF90_REAL8) ) THEN
+        IF (l_ea > 1) THEN
+          ALLOCATE(tma_r(l_ea))
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tma_r)
+          WRITE (*,'("    ",A," :",/,(5(1X,1PE11.3),:))') &
+ &          TRIM(c_name),tma_r(1:l_ea)
+          DEALLOCATE(tma_r)
+        ELSE
+          i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_r)
+          WRITE(*,*) '   ',TRIM(c_name),' : ',tmp_r
+        ENDIF
+      ELSE
+        tmp_c = ''
+        i_rc = NF90_GET_ATT(f_e,i_n,c_name,tmp_c)
+        WRITE(*,*) '   ',TRIM(c_name),' : "',TRIM(tmp_c),'"'
+      ENDIF
+    ENDDO
+  ENDDO
+  WRITE (*,*) "---"
+!-
+  i_rc = NF90_CLOSE(f_e)
+!----------------------
+END SUBROUTINE fliodmpf
+!===
+SUBROUTINE flio_dom_set &
+ & (dtnb,dnb,did,dsg,dsl,dpf,dpl,dhs,dhe,cdnm,id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: dtnb,dnb
+  INTEGER,DIMENSION(:),INTENT(IN) :: did,dsg,dsl,dpf,dpl,dhs,dhe
+  CHARACTER(LEN=*),INTENT(IN) :: cdnm
+  INTEGER,INTENT(OUT) :: id_dom
+!-
+  INTEGER :: k_w,i_w,i_s
+  CHARACTER(LEN=l_dns) :: cd_p,cd_w
+!---------------------------------------------------------------------
+  k_w = flio_dom_rid()
+  IF (k_w < 0) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'too many domains simultaneously defined', &
+ &   'please unset useless domains', &
+ &   'by calling flio_dom_unset')
+  ENDIF
+  id_dom = k_w
+!-
+  d_n_t(k_w) = dtnb
+  d_n_c(k_w) = dnb
+!-
+  i_s = SIZE(did)
+  IF (i_s > dom_max_dims) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'too many distributed dimensions', &
+ &   'simultaneously defined',' ')
+  ENDIF
+  d_d_n(k_w) = i_s
+  d_d_i(1:i_s,k_w) = did(1:i_s)
+!-
+  i_w = SIZE(dsg)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_size_global array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_s_g(1:i_w,k_w) = dsg(1:i_w)
+!-
+  i_w = SIZE(dsl)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_size_local array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_s_l(1:i_w,k_w) = dsl(1:i_w)
+!-
+  i_w = SIZE(dpf)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_position_first array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_p_f(1:i_w,k_w) = dpf(1:i_w)
+!-
+  i_w = SIZE(dpl)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_position_last array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_p_l(1:i_w,k_w) = dpl(1:i_w)
+!-
+  i_w = SIZE(dhs)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_halo_size_start array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_h_s(1:i_w,k_w) = dhs(1:i_w)
+!-
+  i_w = SIZE(dhe)
+  IF (i_w /= i_s) THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'the size of the DOMAIN_halo_size_end array', &
+ &   'is not equal to the size', &
+ &   'of the distributed dimensions array')
+  ENDIF
+  d_h_e(1:i_w,k_w) = dhe(1:i_w)
+!-
+  cd_p = "unknown"
+  cd_w = cdnm; CALL strlowercase (cd_w)
+  DO i_w=1,n_dns
+    IF (TRIM(cd_w) == TRIM(c_dns(i_w))) THEN
+      cd_p = cd_w; EXIT;
+    ENDIF
+  ENDDO
+  IF (TRIM(cd_p) == "unknown") THEN
+    CALL ipslerr (3,'flio_dom_set', &
+ &   'DOMAIN_type "'//TRIM(cdnm)//'"', &
+ &   'is actually not supported', &
+ &   'please use one of the supported names')
+  ENDIF
+  c_d_t(k_w) = cd_p
+!--------------------------
+END SUBROUTINE flio_dom_set
+!===
+SUBROUTINE flio_dom_unset (id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN),OPTIONAL :: id_dom
+!-
+  INTEGER :: i_w
+!---------------------------------------------------------------------
+  IF (PRESENT(id_dom)) THEN
+    IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+      IF (d_d_n(id_dom) > 0) THEN
+        d_d_n(id_dom) = -1
+      ELSE
+        CALL ipslerr (2,'flio_dom_unset', &
+ &       'The domain is not set',' ',' ')
+      ENDIF
+    ELSE
+      CALL ipslerr (2,'flio_dom_unset', &
+ &     'Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    DO i_w=1,dom_max_nb
+      d_d_n(id_dom) = -1
+    ENDDO
+  ENDIF
+!----------------------------
+END SUBROUTINE flio_dom_unset
+!===
+SUBROUTINE flio_dom_defset (id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: id_dom
+!---------------------------------------------------------------------
+  IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+    id_def_dom = id_dom
+  ELSE
+    CALL ipslerr (3,'flio_dom_defset', &
+ &   'Invalid domain identifier',' ',' ')
+  ENDIF
+!-----------------------------
+END SUBROUTINE flio_dom_defset
+!===
+SUBROUTINE flio_dom_defunset ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!---------------------------------------------------------------------
+  id_def_dom = FLIO_DOM_NONE
+!-------------------------------
+END SUBROUTINE flio_dom_defunset
+!===
+SUBROUTINE flio_dom_definq (id_dom)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: id_dom
+!---------------------------------------------------------------------
+  id_dom = id_def_dom
+!-----------------------------
+END SUBROUTINE flio_dom_definq
+!===
+!-
+!---------------------------------------------------------------------
+!- Semi-public procedures
+!---------------------------------------------------------------------
+!-
+!===
+SUBROUTINE flio_dom_file (f_n,id_dom)
+!---------------------------------------------------------------------
+!- Update the model file name to include the ".nc" suffix and
+!- the DOMAIN number on which this copy of IOIPSL runs, if needed.
+!- This routine is called by IOIPSL and not by user anyway.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(INOUT) :: f_n
+  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
+!-
+  INTEGER :: il,iw
+  CHARACTER(LEN=4) :: str
+!---------------------------------------------------------------------
+!-
+! Add the ".nc" suffix if needed
+  il = LEN_TRIM(f_n)
+  IF (f_n(il-2:il) /= '.nc') THEN
+    f_n = f_n(1:il)//'.nc'
+  ENDIF
+!-
+! Add the DOMAIN identifier if needed
+  IF (PRESENT(id_dom)) THEN
+    IF (id_dom == FLIO_DOM_DEFAULT) THEN
+      CALL flio_dom_definq (iw)
+    ELSE
+      iw = id_dom
+    ENDIF
+    IF (iw /= FLIO_DOM_NONE) THEN
+      IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+        IF (d_d_n(iw) > 0) THEN
+          WRITE(str,'(I4.4)') d_n_c(iw)
+          il = INDEX(f_n,'.nc')
+          f_n = f_n(1:il-1)//'_'//str//'.nc'
+        ELSE
+          CALL ipslerr (3,'flio_dom_file', &
+ &         'The domain has not been defined', &
+ &         'please call flio_dom_set', &
+ &         'before calling flio_dom_file')
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'flio_dom_file', &
+ &       'Invalid domain identifier',' ',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!---------------------------
+END SUBROUTINE flio_dom_file
+!===
+SUBROUTINE flio_dom_att (f_e,id_dom)
+!---------------------------------------------------------------------
+!- Add the DOMAIN attributes to the NETCDF file.
+!- This routine is called by IOIPSL and not by user anyway.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: f_e
+  INTEGER,OPTIONAL,INTENT(IN) :: id_dom
+!-
+  INTEGER :: iw,i_rc,i_n
+  CHARACTER(LEN=15) :: c_ddim
+  INTEGER :: n_idim
+  CHARACTER(LEN=NF90_MAX_NAME) :: c_ndim
+!---------------------------------------------------------------------
+  IF (PRESENT(id_dom)) THEN
+    IF (id_dom == FLIO_DOM_DEFAULT) THEN
+      CALL flio_dom_definq (iw)
+    ELSE
+      iw = id_dom
+    ENDIF
+    IF (iw /= FLIO_DOM_NONE) THEN
+      IF ( (id_dom >= 1).AND.(id_dom <= dom_max_nb) ) THEN
+        IF (d_d_n(iw) > 0) THEN
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_number_total',d_n_t(iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_number',d_n_c(iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_dimensions_ids',d_d_i(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_size_global',d_s_g(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_size_local',d_s_l(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_position_first',d_p_f(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_position_last',d_p_l(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_halo_size_start',d_h_s(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_halo_size_end',d_h_e(1:d_d_n(iw),iw))
+          i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL, &
+ &          'DOMAIN_type',TRIM(c_d_t(iw)))
+          i_rc = NF90_INQUIRE (f_e,nDimensions=n_idim)
+          DO i_n=1,n_idim
+            i_rc = NF90_INQUIRE_DIMENSION (f_e,i_n,name=c_ndim)
+            WRITE (UNIT=c_ddim,FMT='("DOMAIN_DIM_N",I3.3)') i_n
+            i_rc = NF90_PUT_ATT (f_e,NF90_GLOBAL,c_ddim,TRIM(c_ndim))
+          ENDDO
+        ELSE
+          CALL ipslerr (3,'flio_dom_att', &
+ &         'The domain has not been defined', &
+ &         'please call flio_dom_set', &
+ &         'before calling flio_dom_att')
+        ENDIF
+      ELSE
+        CALL ipslerr (3,'flio_dom_att', &
+ &       'Invalid domain identifier',' ',' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!--------------------------
+END SUBROUTINE flio_dom_att
+!===
+!-
+!---------------------------------------------------------------------
+!- Local procedures
+!---------------------------------------------------------------------
+!-
+!===
+INTEGER FUNCTION flio_rid()
+!---------------------------------------------------------------------
+!- returns a free index in nw_id(:)
+!---------------------------------------------------------------------
+  INTEGER,DIMENSION(1:1) :: nfi
+!-
+  IF (ANY(nw_id < 0)) THEN
+    nfi = MINLOC(nw_id,MASK=nw_id < 0)
+    flio_rid = nfi(1)
+  ELSE
+    flio_rid = -1
+  ENDIF
+!--------------------
+END FUNCTION flio_rid
+!===
+INTEGER FUNCTION flio_dom_rid()
+!---------------------------------------------------------------------
+!- returns a free index in d_d_n(:)
+!---------------------------------------------------------------------
+  INTEGER,DIMENSION(1:1) :: nd
+!---------------------------------------------------------------------
+  IF (ANY(d_d_n < 0)) THEN
+    nd = MINLOC(d_d_n,MASK=d_d_n < 0)
+    flio_dom_rid = nd(1)
+  ELSE
+    flio_dom_rid = -1
+  ENDIF
+!------------------------
+END FUNCTION flio_dom_rid
+!===
+INTEGER FUNCTION flio_qid(iid)
+!---------------------------------------------------------------------
+!- returns the external index associated with the internal index "iid"
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: iid
+!---------------------------------------------------------------------
+  IF ( (iid >= 1).AND.(iid <= nb_fi_mx) ) THEN
+    flio_qid = nw_id(iid)
+  ELSE
+    flio_qid = -1
+  ENDIF
+!--------------------
+END FUNCTION flio_qid
+!===
+SUBROUTINE flio_qvid (cpg,iid,ixd)
+!---------------------------------------------------------------------
+!- This subroutine, called by the procedure "cpg",
+!- validates and returns the external file index "ixd"
+!- associated with the internal file index "iid"
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: cpg
+  INTEGER,INTENT(IN)  :: iid
+  INTEGER,INTENT(OUT) :: ixd
+!-
+  CHARACTER(LEN=20) :: c_t
+!---------------------------------------------------------------------
+  ixd = flio_qid(iid)
+  IF (ixd < 0) THEN
+    WRITE (UNIT=c_t,FMT='(I15)') iid
+    CALL ipslerr (3,TRIM(cpg), &
+ &    'Invalid internal file index :',TRIM(ADJUSTL(c_t)),' ')
+  ENDIF
+!-----------------------
+END SUBROUTINE flio_qvid
+!===
+SUBROUTINE flio_hdm (f_i,f_e,lk_hm)
+!---------------------------------------------------------------------
+!- This subroutine handles the "define/data mode" of NETCDF.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_i,f_e
+  LOGICAL,INTENT(IN) :: lk_hm
+!-
+  INTEGER :: i_rc
+!---------------------------------------------------------------------
+  i_rc = NF90_NOERR
+!-
+  IF      ( (.NOT.lw_hm(f_i)).AND.(lk_hm) ) THEN
+    i_rc = NF90_REDEF(f_e)
+    lw_hm(f_i) = .TRUE.
+  ELSE IF ( (lw_hm(f_i)).AND.(.NOT.lk_hm) ) THEN
+    i_rc = NF90_ENDDEF(f_e)
+    lw_hm(f_i) = .FALSE.
+  ENDIF
+!-
+  IF (i_rc /= NF90_NOERR) THEN
+    CALL ipslerr (3,'flio_hdm', &
+ &    'Internal error ','in define/data mode :', &
+ &    TRIM(NF90_STRERROR(i_rc)))
+  ENDIF
+!----------------------
+END SUBROUTINE flio_hdm
+!===
+SUBROUTINE flio_inf (f_e, &
+ & nb_dims,nb_vars,nb_atts,id_unlm,nn_idm,nn_ldm,nn_aid,cc_ndm)
+!---------------------------------------------------------------------
+!- This subroutine allows to get some information concerning
+!- the model file whose the external identifier is "f_e".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: f_e
+  INTEGER,OPTIONAL,INTENT(OUT) :: nb_dims,nb_vars,nb_atts,id_unlm
+  INTEGER,DIMENSION(:),OPTIONAL,INTENT(OUT) :: nn_idm,nn_ldm,nn_aid
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL,INTENT(OUT) :: cc_ndm
+!-
+  INTEGER :: nm_dims,nm_vars,nm_atts,nm_unlm,ml
+  INTEGER :: i_rc,kv
+  CHARACTER(LEN=NF90_MAX_NAME) :: f_d_n
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->flio_inf"
+  ENDIF
+!-
+  i_rc = NF90_INQUIRE(f_e,nDimensions=nm_dims,nVariables=nm_vars, &
+ &                    nAttributes=nm_atts,unlimitedDimId=nm_unlm)
+!-
+  IF (PRESENT(nb_dims))  nb_dims = nm_dims;
+  IF (PRESENT(nb_vars))  nb_vars = nm_vars;
+  IF (PRESENT(nb_atts))  nb_atts = nm_atts;
+  IF (PRESENT(id_unlm))  id_unlm = nm_unlm;
+!-
+  IF (PRESENT(nn_idm))  nn_idm(:) =  -1;
+  IF (PRESENT(nn_ldm))  nn_ldm(:) =   0;
+  IF (PRESENT(cc_ndm))  cc_ndm(:) = ' ';
+  IF (PRESENT(nn_aid))  nn_aid(:) =  -1;
+!-
+  DO kv=1,nm_dims
+!---
+    i_rc = NF90_INQUIRE_DIMENSION(f_e,kv,name=f_d_n,len=ml)
+    CALL strlowercase (f_d_n)
+    f_d_n = ADJUSTL(f_d_n)
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) "  flio_inf ",kv,ml," ",TRIM(f_d_n)
+    ENDIF
+!---
+    IF (PRESENT(nn_idm))  nn_idm(kv)=kv;
+    IF (PRESENT(nn_ldm))  nn_ldm(kv)=ml;
+    IF (PRESENT(cc_ndm))  cc_ndm(kv)=TRIM(f_d_n);
+!---
+    IF      (    (INDEX(f_d_n,'x') == 1)   &
+ &           .OR.(INDEX(f_d_n,'lon') == 1) ) THEN
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_lon) < 0) THEN
+          nn_aid(k_lon)=kv;
+        ENDIF
+      ENDIF
+    ELSE IF (    (INDEX(f_d_n,'y') == 1)   &
+ &           .OR.(INDEX(f_d_n,'lat') == 1) ) THEN
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_lat) < 0) THEN
+          nn_aid(k_lat)=kv;
+        ENDIF
+      ENDIF
+    ELSE IF (    (INDEX(f_d_n,'z') == 1)     &
+ &           .OR.(INDEX(f_d_n,'lev') == 1)   &
+ &           .OR.(INDEX(f_d_n,'plev') == 1)  &
+ &           .OR.(INDEX(f_d_n,'depth') == 1) ) THEN
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_lev) < 0) THEN
+          nn_aid(k_lev)=kv;
+        ENDIF
+      ENDIF
+    ELSE IF (    (TRIM(f_d_n) == 't')         &
+ &           .OR.(TRIM(f_d_n) == 'time')      &
+ &           .OR.(INDEX(f_d_n,'tstep') == 1)  &
+ &           .OR.(INDEX(f_d_n,'time_counter') == 1) ) THEN
+!---- For the time we certainly need to allow for other names
+      IF (PRESENT(nn_aid)) THEN
+        IF (nn_aid(k_tim) < 0) THEN
+          nn_aid(k_tim)=kv;
+        ENDIF
+      ENDIF
+    ENDIF
+!---
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-flio_inf"
+  ENDIF
+!----------------------
+END SUBROUTINE flio_inf
+!===
+SUBROUTINE flio_qax (f_i,axtype,i_v,nbd)
+!---------------------------------------------------------------------
+!- This subroutine explores the file in order to find
+!- an axis (x/y/z/t) according to a number of rules
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: f_i,i_v,nbd
+  CHARACTER(LEN=*) :: axtype
+!-
+  INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb
+  CHARACTER(LEN=1)  :: c_ax
+  CHARACTER(LEN=18) :: c_sn
+  CHARACTER(LEN=15),DIMENSION(10) :: c_r
+  CHARACTER(LEN=40) :: c_t1,c_t2
+!---------------------------------------------------------------------
+  i_v = -1; nbd = -1;
+!---
+!- Keep the name of the axis
+!---
+  c_ax = TRIM(axtype)
+!-
+! Validate axis type
+!-
+  IF (    (LEN_TRIM(axtype) == 1) &
+ &    .AND.(    (c_ax == 'x').OR.(c_ax == 'y') &
+ &          .OR.(c_ax == 'z').OR.(c_ax == 't')) ) THEN
+!---
+!-- Define the maximum number of dimensions for the coordinate
+!---
+      SELECT CASE (c_ax)
+      CASE('x')
+        l_d = 2
+        c_sn = 'longitude'
+      CASE('y')
+        l_d = 2
+        c_sn = 'latitude'
+      CASE('z')
+        l_d = 1
+        c_sn = 'model_level_number'
+      CASE('t')
+        l_d = 1
+        c_sn = 'time'
+      END SELECT
+!---
+!-- Rule 1 : we look for a variable with one dimension
+!--          and which has the same name as its dimension (NUG)
+!---
+    IF (i_v < 0) THEN
+      SELECT CASE (c_ax)
+      CASE('x')
+        k = nw_ai(k_lon,f_i)
+      CASE('y')
+        k = nw_ai(k_lat,f_i)
+      CASE('z')
+        k = nw_ai(k_lev,f_i)
+      CASE('t')
+        k = nw_ai(k_tim,f_i)
+      END SELECT
+      IF ( (k >= 1).AND.(k <= nb_ax_mx) ) THEN
+        dimnb = nw_di(k,f_i)
+      ELSE
+        dimnb = -1
+      ENDIF
+!-----
+      i_rc = NF90_INQUIRE_DIMENSION(nw_id(f_i),dimnb,name=c_t1)
+      IF (i_rc == NF90_NOERR) THEN
+        CALL strlowercase (c_t1)
+        L_R1: DO kv=1,nw_nv(f_i)
+          i_rc = NF90_INQUIRE_VARIABLE &
+ &                 (nw_id(f_i),kv,name=c_t2,ndims=n_d)
+          IF (n_d == 1) THEN
+            CALL strlowercase (c_t2)
+            IF (TRIM(c_t1) == TRIM(c_t2)) THEN
+              i_v = kv; nbd = n_d;
+              EXIT L_R1
+            ENDIF
+          ENDIF
+        ENDDO L_R1
+      ENDIF
+    ENDIF
+!---
+!-- Rule 2 : we look for a correct "axis" attribute (CF)
+!---
+    IF (i_v < 0) THEN
+      L_R2: DO kv=1,nw_nv(f_i)
+        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'axis',c_t1)
+        IF (i_rc == NF90_NOERR) THEN
+          CALL strlowercase (c_t1)
+          IF (TRIM(c_t1) == c_ax) THEN
+            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
+            IF (n_d <= l_d) THEN
+              i_v = kv; nbd = n_d;
+              EXIT L_R2
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDDO L_R2
+    ENDIF
+!---
+!-- Rule 3 : we look for a correct "standard_name" attribute (CF)
+!---
+    IF (i_v < 0) THEN
+      L_R3: DO kv=1,nw_nv(f_i)
+        i_rc = NF90_GET_ATT(nw_id(f_i),kv,'standard_name',c_t1)
+        IF (i_rc == NF90_NOERR) THEN
+          CALL strlowercase (c_t1)
+          IF (TRIM(c_t1) == TRIM(c_sn)) THEN
+            i_rc = NF90_INQUIRE_VARIABLE(nw_id(f_i),kv,ndims=n_d)
+            IF (n_d <= l_d) THEN
+              i_v = kv; nbd = n_d;
+              EXIT L_R3
+            ENDIF
+          ENDIF
+        ENDIF
+      ENDDO L_R3
+    ENDIF
+!---
+!-- Rule 4 : we look for a specific name (IOIPSL)
+!---
+    IF (i_v < 0) THEN
+      SELECT CASE (c_ax)
+      CASE('x')
+        n_r = 3
+        c_r(1)='nav_lon'; c_r(2)='lon'; c_r(3)='longitude';
+      CASE('y')
+        n_r = 3
+        c_r(1)='nav_lat'; c_r(2)='lat'; c_r(3)='latitude';
+      CASE('z')
+        n_r = 8
+        c_r(1)='depth'; c_r(2)='deptht'; c_r(3)='height';
+        c_r(4)='level'; c_r(5)='lev'; c_r(6)='plev';
+        c_r(7)='sigma_level'; c_r(8)='layer';
+      CASE('t')
+        n_r = 3
+        c_r(1)='time'; c_r(2)='tstep'; c_r(3)='timesteps';
+      END SELECT
+!-----
+      L_R4: DO kv=1,nw_nv(f_i)
+        i_rc = NF90_INQUIRE_VARIABLE &
+ &               (nw_id(f_i),kv,name=c_t1,ndims=n_d)
+        IF (i_rc == NF90_NOERR) THEN
+          CALL strlowercase (c_t1)
+          IF (n_d <= l_d) THEN
+            DO k=1,n_r
+              IF (TRIM(c_t1) == TRIM(c_r(k))) THEN
+                i_v = kv; nbd = n_d;
+                EXIT L_R4
+              ENDIF
+            ENDDO
+          ENDIF
+        ENDIF
+      ENDDO L_R4
+    ENDIF
+!---
+  ENDIF
+!----------------------
+END SUBROUTINE flio_qax
+!-
+!===
+!-
+END MODULE fliocom
Index: vendors/IOIPSL/src/getincom.f90
===================================================================
--- vendors/IOIPSL/src/getincom.f90	(revision 9621)
+++ vendors/IOIPSL/src/getincom.f90	(revision 9621)
@@ -0,0 +1,2008 @@
+MODULE getincom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+USE errioipsl, ONLY : ipslerr
+USE stringop, &
+ &   ONLY : nocomma,cmpblank,strlowercase
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+PUBLIC :: getin_name, getin, getin_dump
+!-
+!!--------------------------------------------------------------------
+!! The "getin_name" routine allows the user to change the name
+!! of the definition file in which the data will be read.
+!! ("run.def" by default)
+!!
+!!  SUBROUTINE getin_name (file_name)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) file_name :  the name of the file
+!!                  in which the data will be read
+!!--------------------------------------------------------------------
+!-
+!-
+INTERFACE getin
+!!--------------------------------------------------------------------
+!! The "getin" routines get a variable.
+!! We first check if we find it in the database
+!! and if not we get it from the definition file.
+!!
+!! SUBROUTINE getin (target,ret_val)
+!!
+!! INPUT
+!!
+!! (C) target : Name of the variable
+!!
+!! OUTPUT
+!!
+!! (I/R/C/L) ret_val : scalar, vector or matrix that will contain
+!!                     that will contain the (standard)
+!!                     integer/real/character/logical values
+!!--------------------------------------------------------------------
+  MODULE PROCEDURE getinrs, getinr1d, getinr2d, &
+ &                 getinis, getini1d, getini2d, &
+ &                 getincs, getinc1d, getinc2d, &
+ &                 getinls, getinl1d, getinl2d
+END INTERFACE
+!-
+!!--------------------------------------------------------------------
+!! The "getin_dump" routine will dump the content of the database
+!! into a file which has the same format as the definition file.
+!! The idea is that the user can see which parameters were used
+!! and re-use the file for another run.
+!!
+!!  SUBROUTINE getin_dump (fileprefix)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) fileprefix : allows the user to change the name of the file
+!!                  in which the data will be archived
+!!--------------------------------------------------------------------
+!-
+  INTEGER,PARAMETER :: max_files=100
+  CHARACTER(LEN=100),DIMENSION(max_files),SAVE :: filelist
+  INTEGER,SAVE      :: nbfiles
+!-
+  INTEGER,SAVE :: allread=0
+  CHARACTER(LEN=100),SAVE :: def_file = 'run.def'
+!-
+  INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
+  INTEGER,SAVE :: nb_lines,i_txtsize=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: fichier
+  CHARACTER(LEN=l_n),SAVE,ALLOCATABLE,DIMENSION(:) :: targetlist
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: fromfile,compline
+!-
+  INTEGER,PARAMETER :: n_d_fmt=5,max_msgs=15
+  CHARACTER(LEN=6),SAVE :: c_i_fmt = '(I5.5)'
+!-
+! The data base of parameters
+!-
+  INTEGER,PARAMETER :: memslabs=200
+  INTEGER,PARAMETER :: compress_lim=20
+!-
+  INTEGER,SAVE :: nb_keys=0
+  INTEGER,SAVE :: keymemsize=0
+!-
+! keystr definition
+! name of a key
+!-
+! keystatus definition
+! keystatus = 1 : Value comes from the file defined by 'def_file'
+! keystatus = 2 : Default value is used
+! keystatus = 3 : Some vector elements were taken from default
+!-
+! keytype definition
+! keytype = 1 : Integer
+! keytype = 2 : Real
+! keytype = 3 : Character
+! keytype = 4 : Logical
+!-
+  INTEGER,PARAMETER :: k_i=1, k_r=2, k_c=3, k_l=4
+!-
+! Allow compression for keys (only for integer and real)
+! keycompress < 0 : not compressed
+! keycompress > 0 : number of repeat of the value
+!-
+TYPE :: t_key
+  CHARACTER(LEN=l_n) :: keystr
+  INTEGER :: keystatus, keytype, keycompress, &
+ &           keyfromfile, keymemstart, keymemlen
+END TYPE t_key
+!-
+  TYPE(t_key),SAVE,ALLOCATABLE,DIMENSION(:) :: key_tab
+!-
+  INTEGER,SAVE,ALLOCATABLE,DIMENSION(:) :: i_mem
+  INTEGER,SAVE :: i_memsize=0, i_mempos=0
+  REAL,SAVE,ALLOCATABLE,DIMENSION(:) :: r_mem
+  INTEGER,SAVE :: r_memsize=0, r_mempos=0
+  CHARACTER(LEN=100),SAVE,ALLOCATABLE,DIMENSION(:) :: c_mem
+  INTEGER,SAVE :: c_memsize=0, c_mempos=0
+  LOGICAL,SAVE,ALLOCATABLE,DIMENSION(:) :: l_mem
+  INTEGER,SAVE :: l_memsize=0, l_mempos=0
+!-
+CONTAINS
+!-
+!=== DEFINITION FILE NAME INTERFACE
+!-
+SUBROUTINE getin_name (cname)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: cname
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+    def_file = ADJUSTL(cname)
+  ELSE
+    CALL ipslerr (3,'getin_name', &
+ &   'The name of the database file (any_name.def)', &
+ &   'must be changed *before* any attempt','to read the database.')
+  ENDIF
+!------------------------
+END SUBROUTINE getin_name
+!-
+!=== INTEGER INTERFACE
+!-
+SUBROUTINE getinis (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: ret_val
+!-
+  INTEGER,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinis
+!===
+SUBROUTINE getini1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getini1d
+!===
+SUBROUTINE getini2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:,:) :: ret_val
+!-
+  INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,i_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,i_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,i_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getini2d
+!-
+!=== REAL INTERFACE
+!-
+SUBROUTINE getinrs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL :: ret_val
+!-
+  REAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinrs
+!===
+SUBROUTINE getinr1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinr1d
+!===
+SUBROUTINE getinr2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  REAL,DIMENSION(:,:) :: ret_val
+!-
+  REAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,r_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,r_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,r_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinr2d
+!-
+!=== CHARACTER INTERFACE
+!-
+SUBROUTINE getincs (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getincs
+!===
+SUBROUTINE getinc1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinc1d
+!===
+SUBROUTINE getinc2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  CHARACTER(LEN=*),DIMENSION(:,:) :: ret_val
+!-
+  CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,c_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,c_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,c_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinc2d
+!-
+!=== LOGICAL INTERFACE
+!-
+SUBROUTINE getinls (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL :: ret_val
+!-
+  LOGICAL,DIMENSION(1) :: tmp_ret_val
+  INTEGER :: pos,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  tmp_ret_val(1) = ret_val
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,1,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,1,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val = tmp_ret_val(1)
+!---------------------
+END SUBROUTINE getinls
+!===
+SUBROUTINE getinl1d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,status=0,fileorig
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+  tmp_ret_val(1:size_of_in) = ret_val(1:size_of_in)
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+  ret_val(1:size_of_in) = tmp_ret_val(1:size_of_in)
+!----------------------
+END SUBROUTINE getinl1d
+!===
+SUBROUTINE getinl2d (target,ret_val)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  LOGICAL,DIMENSION(:,:) :: ret_val
+!-
+  LOGICAL,DIMENSION(:),ALLOCATABLE,SAVE :: tmp_ret_val
+  INTEGER,SAVE :: tmp_ret_size = 0
+  INTEGER :: pos,size_of_in,size_1,size_2,status=0,fileorig
+  INTEGER :: jl,jj,ji
+!---------------------------------------------------------------------
+!-
+! Do we have this target in our database ?
+!-
+  CALL get_findkey (1,target,pos)
+!-
+  size_of_in = SIZE(ret_val)
+  size_1 = SIZE(ret_val,1)
+  size_2 = SIZE(ret_val,2)
+  IF (.NOT.ALLOCATED(tmp_ret_val)) THEN
+    ALLOCATE (tmp_ret_val(size_of_in))
+  ELSE IF (size_of_in > tmp_ret_size) THEN
+    DEALLOCATE (tmp_ret_val)
+    ALLOCATE (tmp_ret_val(size_of_in))
+    tmp_ret_size = size_of_in
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      tmp_ret_val(jl) = ret_val(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  IF (pos < 0) THEN
+!-- Get the information out of the file
+    CALL get_fil (target,status,fileorig,l_val=tmp_ret_val)
+!-- Put the data into the database
+    CALL get_wdb &
+ &   (target,status,fileorig,size_of_in,l_val=tmp_ret_val)
+  ELSE
+!-- Get the value out of the database
+    CALL get_rdb (pos,size_of_in,target,l_val=tmp_ret_val)
+  ENDIF
+!-
+  jl=0
+  DO jj=1,size_2
+    DO ji=1,size_1
+      jl=jl+1
+      ret_val(ji,jj) = tmp_ret_val(jl)
+    ENDDO
+  ENDDO
+!----------------------
+END SUBROUTINE getinl2d
+!-
+!=== Generic file/database INTERFACE
+!-
+SUBROUTINE get_fil (target,status,fileorig,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Subroutine that will extract from the file the values
+!- attributed to the keyword target
+!-
+!- (C) target    : target for which we will look in the file
+!- (I) status    : tells us from where we obtained the data
+!- (I) fileorig  : index of the file from which the key comes
+!- (I) i_val(:)  : INTEGER(nb_to_ret)   values
+!- (R) r_val(:)  : REAL(nb_to_ret)      values
+!- (L) l_val(:)  : LOGICAL(nb_to_ret)   values
+!- (C) c_val(:)  : CHARACTER(nb_to_ret) values
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER,INTENT(OUT) :: status,fileorig
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,nb_to_ret,it,pos,len_str,status_cnt,io_err
+  CHARACTER(LEN=n_d_fmt)  :: cnt
+  CHARACTER(LEN=80) :: str_READ,str_READ_lower
+  CHARACTER(LEN=9)  :: c_vtyp
+  LOGICAL,DIMENSION(:),ALLOCATABLE :: found
+  LOGICAL :: def_beha,compressed
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: i_cmpval
+  REAL    :: r_cmpval
+  INTEGER :: ipos_tr,ipos_fl
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    nb_to_ret = SIZE(i_val)
+  CASE(k_r)
+    nb_to_ret = SIZE(r_val)
+  CASE(k_c)
+    nb_to_ret = SIZE(c_val)
+  CASE(k_l)
+    nb_to_ret = SIZE(l_val)
+  CASE DEFAULT
+    CALL ipslerr (3,'get_fil', &
+ &   'Internal error','Unknown type of data',' ')
+  END SELECT
+!-
+! Read the file(s)
+  CALL getin_read
+!-
+! Allocate and initialize the memory we need
+  ALLOCATE(found(nb_to_ret))
+  found(:) = .FALSE.
+!-
+! See what we find in the files read
+  DO it=1,nb_to_ret
+!---
+!-- First try the target as it is
+    CALL get_findkey (2,target,pos)
+!---
+!-- Another try
+!---
+    IF (pos < 0) THEN
+      WRITE(UNIT=cnt,FMT=c_i_fmt) it
+      CALL get_findkey (2,TRIM(target)//'__'//cnt,pos)
+    ENDIF
+!---
+!-- We dont know from which file the target could come.
+!-- Thus by default we attribute it to the first file :
+    fileorig = 1
+!---
+    IF (pos > 0) THEN
+!-----
+      found(it) = .TRUE.
+      fileorig = fromfile(pos)
+!-----
+!---- DECODE
+!-----
+      str_READ = ADJUSTL(fichier(pos))
+      str_READ_lower = str_READ
+      CALL strlowercase (str_READ_lower)
+!-----
+      IF (    (TRIM(str_READ_lower) == 'def')     &
+ &        .OR.(TRIM(str_READ_lower) == 'default') ) THEN
+        def_beha = .TRUE.
+      ELSE
+        def_beha = .FALSE.
+        len_str = LEN_TRIM(str_READ)
+        io_err = 0
+        SELECT CASE (k_typ)
+        CASE(k_i)
+          WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') len_str
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=c_fmt,IOSTAT=io_err) i_val(it)
+        CASE(k_r)
+          READ (UNIT=str_READ(1:len_str), &
+ &              FMT=*,IOSTAT=io_err) r_val(it)
+        CASE(k_c)
+          c_val(it) = str_READ(1:len_str)
+        CASE(k_l)
+          ipos_tr = -1
+          ipos_fl = -1
+          ipos_tr = MAX(INDEX(str_READ_lower,'tru'), &
+ &                      INDEX(str_READ_lower,'y'))
+          ipos_fl = MAX(INDEX(str_READ_lower,'fal'), &
+ &                      INDEX(str_READ_lower,'n'))
+          IF (ipos_tr > 0) THEN
+            l_val(it) = .TRUE.
+          ELSE IF (ipos_fl > 0) THEN
+            l_val(it) = .FALSE.
+          ELSE
+            io_err = 100
+          ENDIF
+        END SELECT
+        IF (io_err /= 0) THEN
+          CALL ipslerr (3,'get_fil', &
+ &         'Target '//TRIM(target), &
+ &         'is not of '//TRIM(c_vtyp)//' type',' ')
+        ENDIF
+      ENDIF
+!-----
+      IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!-------
+!------ Is this the value of a compressed field ?
+        compressed = (compline(pos) > 0)
+        IF (compressed) THEN
+          IF (compline(pos) /= nb_to_ret) THEN
+            CALL ipslerr (2,'get_fil', &
+ &           'For key '//TRIM(target)//' we have a compressed field', &
+ &           'which does not have the right size.', &
+ &           'We will try to fix that.')
+          ENDIF
+          IF      (k_typ == k_i) THEN
+            i_cmpval = i_val(it)
+          ELSE IF (k_typ == k_r) THEN
+            r_cmpval = r_val(it)
+          ENDIF
+        ENDIF
+      ENDIF
+    ELSE
+      found(it) = .FALSE.
+      def_beha = .FALSE.
+      compressed = .FALSE.
+    ENDIF
+  ENDDO
+!-
+  IF ( (k_typ == k_i).OR.(k_typ == k_r) ) THEN
+!---
+!-- If this is a compressed field then we will uncompress it
+    IF (compressed) THEN
+      DO it=1,nb_to_ret
+        IF (.NOT.found(it)) THEN
+          IF      (k_typ == k_i) THEN
+            i_val(it) = i_cmpval
+          ELSE IF (k_typ == k_r) THEN
+          ENDIF
+          found(it) = .TRUE.
+        ENDIF
+      ENDDO
+    ENDIF
+  ENDIF
+!-
+! Now we set the status for what we found
+  IF (def_beha) THEN
+    status = 2
+    WRITE(*,*) 'USING DEFAULT BEHAVIOUR FOR ',TRIM(target)
+  ELSE
+    status_cnt = 0
+    DO it=1,nb_to_ret
+      IF (.NOT.found(it)) THEN
+        status_cnt = status_cnt+1
+        IF      (status_cnt <= max_msgs) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS : ",A)', &
+ &               ADVANCE='NO') TRIM(target)
+          IF (nb_to_ret > 1) THEN
+            WRITE (UNIT=*,FMT='("__")',ADVANCE='NO')
+            WRITE (UNIT=*,FMT=c_i_fmt,ADVANCE='NO') it
+          ENDIF
+          SELECT CASE (k_typ)
+          CASE(k_i)
+            WRITE (UNIT=*,FMT=*) "=",i_val(it)
+          CASE(k_r)
+            WRITE (UNIT=*,FMT=*) "=",r_val(it)
+          CASE(k_c)
+            WRITE (UNIT=*,FMT=*) "=",c_val(it)
+          CASE(k_l)
+            WRITE (UNIT=*,FMT=*) "=",l_val(it)
+          END SELECT
+        ELSE IF (status_cnt == max_msgs+1) THEN
+          WRITE (UNIT=*,FMT='(" USING DEFAULTS ... ",A)')
+        ENDIF
+      ENDIF
+    ENDDO
+!---
+    IF (status_cnt == 0) THEN
+      status = 1
+    ELSE IF (status_cnt == nb_to_ret) THEN
+      status = 2
+    ELSE
+      status = 3
+    ENDIF
+  ENDIF
+! Deallocate the memory
+  DEALLOCATE(found)
+!---------------------
+END SUBROUTINE get_fil
+!===
+SUBROUTINE get_rdb (pos,size_of_in,target,i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Read the required variable in the database
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: pos,size_of_in
+  CHARACTER(LEN=*) :: target
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ,k_beg,k_end
+  CHARACTER(LEN=9) :: c_vtyp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keytype /= k_typ) THEN
+    CALL ipslerr (3,'get_rdb', &
+ &   'Wrong data type for keyword '//TRIM(target), &
+ &   '(NOT '//TRIM(c_vtyp)//')',' ')
+  ENDIF
+!-
+  IF (key_tab(pos)%keycompress > 0) THEN
+    IF (    (key_tab(pos)%keycompress /= size_of_in) &
+ &      .OR.(key_tab(pos)%keymemlen /= 1) ) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong compression length','for keyword '//TRIM(target),' ')
+    ELSE
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(key_tab(pos)%keymemstart)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(key_tab(pos)%keymemstart)
+      END SELECT
+    ENDIF
+  ELSE
+    IF (key_tab(pos)%keymemlen /= size_of_in) THEN
+      CALL ipslerr (3,'get_rdb', &
+ &     'Wrong array length','for keyword '//TRIM(target),' ')
+    ELSE
+      k_beg = key_tab(pos)%keymemstart
+      k_end = k_beg+key_tab(pos)%keymemlen-1
+      SELECT CASE (k_typ)
+      CASE(k_i)
+        i_val(1:size_of_in) = i_mem(k_beg:k_end)
+      CASE(k_r)
+        r_val(1:size_of_in) = r_mem(k_beg:k_end)
+      CASE(k_c)
+        c_val(1:size_of_in) = c_mem(k_beg:k_end)
+      CASE(k_l)
+        l_val(1:size_of_in) = l_mem(k_beg:k_end)
+      END SELECT
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE get_rdb
+!===
+SUBROUTINE get_wdb &
+ &  (target,status,fileorig,size_of_in, &
+ &   i_val,r_val,c_val,l_val)
+!---------------------------------------------------------------------
+!- Write data into the data base
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: target
+  INTEGER :: status,fileorig,size_of_in
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_val
+  REAL,DIMENSION(:),OPTIONAL             :: r_val
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_val
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_val
+!-
+  INTEGER :: k_typ
+  CHARACTER(LEN=9) :: c_vtyp
+  INTEGER :: k_mempos,k_memsize,k_beg,k_end
+  LOGICAL :: l_cmp
+!---------------------------------------------------------------------
+!-
+! Get the type of the argument
+  CALL get_qtyp (k_typ,c_vtyp,i_val,r_val,c_val,l_val)
+  IF (     (k_typ /= k_i).AND.(k_typ /= k_r) &
+ &    .AND.(k_typ /= k_c).AND.(k_typ /= k_l) )THEN
+    CALL ipslerr (3,'get_wdb', &
+ &   'Internal error','Unknown type of data',' ')
+  ENDIF
+!-
+! First check if we have sufficiant space for the new key
+  IF (nb_keys+1 > keymemsize) THEN
+    CALL getin_allockeys ()
+  ENDIF
+!-
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    k_mempos = i_mempos; k_memsize = i_memsize;
+    l_cmp = (MINVAL(i_val) == MAXVAL(i_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_r)
+    k_mempos = r_mempos; k_memsize = r_memsize;
+    l_cmp = (MINVAL(r_val) == MAXVAL(r_val)) &
+ &         .AND.(size_of_in > compress_lim)
+  CASE(k_c)
+    k_mempos = c_mempos; k_memsize = c_memsize;
+    l_cmp = .FALSE.
+  CASE(k_l)
+    k_mempos = l_mempos; k_memsize = l_memsize;
+    l_cmp = .FALSE.
+  END SELECT
+!-
+! Fill out the items of the data base
+  nb_keys = nb_keys+1
+  key_tab(nb_keys)%keystr = target(1:MIN(LEN_TRIM(target),l_n))
+  key_tab(nb_keys)%keystatus = status
+  key_tab(nb_keys)%keytype = k_typ
+  key_tab(nb_keys)%keyfromfile = fileorig
+  key_tab(nb_keys)%keymemstart = k_mempos+1
+  IF (l_cmp) THEN
+    key_tab(nb_keys)%keycompress = size_of_in
+    key_tab(nb_keys)%keymemlen = 1
+  ELSE
+    key_tab(nb_keys)%keycompress = -1
+    key_tab(nb_keys)%keymemlen = size_of_in
+  ENDIF
+!-
+! Before writing the actual size lets see if we have the space
+  IF (key_tab(nb_keys)%keymemstart+key_tab(nb_keys)%keymemlen &
+ &    > k_memsize) THEN
+    CALL getin_allocmem (k_typ,key_tab(nb_keys)%keymemlen)
+  ENDIF
+!-
+  k_beg = key_tab(nb_keys)%keymemstart
+  k_end = k_beg+key_tab(nb_keys)%keymemlen-1
+  SELECT CASE (k_typ)
+  CASE(k_i)
+    i_mem(k_beg:k_end) = i_val(1:key_tab(nb_keys)%keymemlen)
+    i_mempos = k_end
+  CASE(k_r)
+    r_mem(k_beg:k_end) = r_val(1:key_tab(nb_keys)%keymemlen)
+    r_mempos = k_end
+  CASE(k_c)
+    c_mem(k_beg:k_end) = c_val(1:key_tab(nb_keys)%keymemlen)
+    c_mempos = k_end
+  CASE(k_l)
+    l_mem(k_beg:k_end) = l_val(1:key_tab(nb_keys)%keymemlen)
+    l_mempos = k_end
+  END SELECT
+!---------------------
+END SUBROUTINE get_wdb
+!-
+!===
+!-
+SUBROUTINE getin_read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,SAVE :: current
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+!-- Allocate a first set of memory.
+    CALL getin_alloctxt ()
+    CALL getin_allockeys ()
+    CALL getin_allocmem (k_i,0)
+    CALL getin_allocmem (k_r,0)
+    CALL getin_allocmem (k_c,0)
+    CALL getin_allocmem (k_l,0)
+!-- Start with reading the files
+    nbfiles = 1
+    filelist(1) = TRIM(def_file)
+    current = 1
+!--
+    DO WHILE (current <= nbfiles)
+      CALL getin_readdef (current)
+      current = current+1
+    ENDDO
+    allread = 1
+    CALL getin_checkcohe ()
+  ENDIF
+!------------------------
+END SUBROUTINE getin_read
+!-
+!===
+!-
+  SUBROUTINE getin_readdef(current)
+!---------------------------------------------------------------------
+!- This subroutine will read the files and only keep the
+!- the relevant information. The information is kept as it
+!- found in the file. The data will be analysed later.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: current
+!-
+  CHARACTER(LEN=100) :: READ_str,NEW_str,last_key,key_str
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+  INTEGER :: nb_lastkey
+!-
+  INTEGER :: eof,ptn,len_str,i,it,iund,io_err
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  eof = 0
+  ptn = 1
+  nb_lastkey = 0
+!-
+  IF (check) THEN
+    WRITE(*,*) 'getin_readdef : Open file ',TRIM(filelist(current))
+  ENDIF
+!-
+  OPEN (UNIT=22,FILE=filelist(current),STATUS="OLD",IOSTAT=io_err)
+  IF (io_err /= 0) THEN
+    CALL ipslerr (2,'getin_readdef', &
+ &  'Could not open file '//TRIM(filelist(current)),' ',' ')
+    RETURN
+  ENDIF
+!-
+  DO WHILE (eof /= 1)
+!---
+    CALL getin_skipafew (22,READ_str,eof,nb_lastkey)
+    len_str = LEN_TRIM(READ_str)
+    ptn = INDEX(READ_str,'=')
+!---
+    IF (ptn > 0) THEN
+!---- Get the target
+      key_str = TRIM(ADJUSTL(READ_str(1:ptn-1)))
+!---- Make sure that a vector keyword has the right length
+      iund = INDEX(key_str,'__')
+      IF (iund > 0) THEN
+        WRITE (UNIT=c_fmt,FMT='("(I",I3.3,")")') &
+ &        LEN_TRIM(key_str)-iund-1
+        READ(UNIT=key_str(iund+2:LEN_TRIM(key_str)), &
+ &           FMT=c_fmt,IOSTAT=io_err) it
+        IF ( (io_err == 0).AND.(it > 0) ) THEN
+          WRITE(UNIT=cnt,FMT=c_i_fmt) it
+          key_str = key_str(1:iund+1)//cnt
+        ELSE
+          CALL ipslerr (3,'getin_readdef', &
+ &         'A very strange key has just been found :', &
+ &         TRIM(key_str),' ')
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(ptn+1:len_str)))
+      CALL nocomma (NEW_str)
+      CALL cmpblank (NEW_str)
+      NEW_str  = TRIM(ADJUSTL(NEW_str))
+      IF (check) THEN
+        WRITE(*,*) &
+ &        '--> getin_readdef : ',TRIM(key_str),' :: ',TRIM(NEW_str)
+      ENDIF
+!---- Decypher the content of NEW_str
+!-
+!---- This has to be a new key word, thus :
+      nb_lastkey = 0
+!----
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+!----
+    ELSE IF (len_str > 0) THEN
+!---- Prepare the key if we have an old one to which
+!---- we will add the line just read
+      IF (nb_lastkey > 0) THEN
+        iund =  INDEX(last_key,'__')
+        IF (iund > 0) THEN
+!-------- We only continue a keyword, thus it is easy
+          key_str = last_key(1:iund-1)
+        ELSE
+          IF (nb_lastkey /= 1) THEN
+            CALL ipslerr (3,'getin_readdef', &
+ &           'We can not have a scalar keyword', &
+ &           'and a vector content',' ')
+          ENDIF
+!-------- The last keyword needs to be transformed into a vector.
+          WRITE(UNIT=cnt,FMT=c_i_fmt) 1
+          targetlist(nb_lines) = &
+ &         last_key(1:MIN(LEN_TRIM(last_key),l_n-n_d_fmt-2))//'__'//cnt
+          key_str = last_key(1:LEN_TRIM(last_key))
+        ENDIF
+      ENDIF
+!---- Prepare the content
+      NEW_str = TRIM(ADJUSTL(READ_str(1:len_str)))
+      CALL getin_decrypt (current,key_str,NEW_str,last_key,nb_lastkey)
+    ELSE
+!---- If we have an empty line then the keyword finishes
+      nb_lastkey = 0
+      IF (check) THEN
+        WRITE(*,*) 'getin_readdef : Have found an emtpy line '
+      ENDIF
+    ENDIF
+  ENDDO
+!-
+  CLOSE(UNIT=22)
+!-
+  IF (check) THEN
+    OPEN (UNIT=22,file=TRIM(def_file)//'.test')
+    DO i=1,nb_lines
+      WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
+    ENDDO
+    CLOSE(UNIT=22)
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_readdef
+!-
+!===
+!-
+SUBROUTINE getin_decrypt(current,key_str,NEW_str,last_key,nb_lastkey)
+!---------------------------------------------------------------------
+!- This subroutine is going to decypher the line.
+!- It essentialy checks how many items are included and
+!- it they can be attached to a key.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! ARGUMENTS
+!-
+  INTEGER :: current,nb_lastkey
+  CHARACTER(LEN=*) :: key_str,NEW_str,last_key
+!-
+! LOCAL
+!-
+  INTEGER :: len_str,blk,nbve,starpos
+  CHARACTER(LEN=100) :: tmp_str,new_key,mult
+  CHARACTER(LEN=n_d_fmt) :: cnt
+  CHARACTER(LEN=10) :: c_fmt
+!---------------------------------------------------------------------
+  len_str = LEN_TRIM(NEW_str)
+  blk = INDEX(NEW_str(1:len_str),' ')
+  tmp_str = NEW_str(1:len_str)
+!-
+! If the key is a new file then we take it up. Else
+! we save the line and go on.
+!-
+  IF (INDEX(key_str,'INCLUDEDEF') > 0) THEN
+    DO WHILE (blk > 0)
+      IF (nbfiles+1 > max_files) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'Too many files to include',' ',' ')
+      ENDIF
+!-----
+      nbfiles = nbfiles+1
+      filelist(nbfiles) = tmp_str(1:blk)
+!-----
+      tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+      blk = INDEX(tmp_str(1:LEN_TRIM(tmp_str)),' ')
+    ENDDO
+!---
+    IF (nbfiles+1 > max_files) THEN
+      CALL ipslerr (3,'getin_decrypt', &
+ &     'Too many files to include',' ',' ')
+    ENDIF
+!---
+    nbfiles =  nbfiles+1
+    filelist(nbfiles) = TRIM(ADJUSTL(tmp_str))
+!---
+    last_key = 'INCLUDEDEF'
+    nb_lastkey = 1
+  ELSE
+!-
+!-- We are working on a new line of input
+!-
+    IF (nb_lines+1 > i_txtsize) THEN
+      CALL getin_alloctxt ()
+    ENDIF
+    nb_lines = nb_lines+1
+!-
+!-- First we solve the issue of conpressed information. Once
+!-- this is done all line can be handled in the same way.
+!-
+    starpos = INDEX(NEW_str(1:len_str),'*')
+    IF ( (starpos > 0).AND.(tmp_str(1:1) /= '"') &
+ &                    .AND.(tmp_str(1:1) /= "'") ) THEN
+!-----
+      IF (INDEX(key_str(1:LEN_TRIM(key_str)),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We can not have a compressed field of values', &
+ &       'in a vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str))
+      ENDIF
+!-
+!---- Read the multiplied
+!-
+      mult = TRIM(ADJUSTL(NEW_str(1:starpos-1)))
+!---- Construct the new string and its parameters
+      NEW_str = TRIM(ADJUSTL(NEW_str(starpos+1:len_str)))
+      len_str = LEN_TRIM(NEW_str)
+      blk = INDEX(NEW_str(1:len_str),' ')
+      IF (blk > 1) THEN
+        CALL ipslerr (2,'getin_decrypt', &
+ &       'This is a strange behavior','you could report',' ')
+      ENDIF
+      WRITE (UNIT=c_fmt,FMT='("(I",I5.5,")")') LEN_TRIM(mult)
+      READ(UNIT=mult,FMT=c_fmt) compline(nb_lines)
+!---
+    ELSE
+      compline(nb_lines) = -1
+    ENDIF
+!-
+!-- If there is no space wthin the line then the target is a scalar
+!-- or the element of a properly written vector.
+!-- (ie of the type TARGET__00001)
+!-
+    IF (    (blk <= 1) &
+ &      .OR.(tmp_str(1:1) == '"') &
+ &      .OR.(tmp_str(1:1) == "'") ) THEN
+!-
+      IF (nb_lastkey == 0) THEN
+!------ Save info of current keyword as a scalar
+!------ if it is not a continuation
+        targetlist(nb_lines) = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        last_key = key_str(1:MIN(LEN_TRIM(key_str),l_n))
+        nb_lastkey = 1
+      ELSE
+!------ We are continuing a vector so the keyword needs
+!------ to get the underscores
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nb_lastkey+1
+        targetlist(nb_lines) = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        last_key = &
+ &        key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        nb_lastkey = nb_lastkey+1
+      ENDIF
+!-----
+      fichier(nb_lines) = NEW_str(1:len_str)
+      fromfile(nb_lines) = current
+    ELSE
+!-
+!---- If there are blanks whithin the line then we are dealing
+!---- with a vector and we need to split it in many entries
+!---- with the TARGET__n notation.
+!----
+!---- Test if the targer is not already a vector target !
+!-
+      IF (INDEX(TRIM(key_str),'__') > 0) THEN
+        CALL ipslerr (3,'getin_decrypt', &
+ &       'We have found a mixed vector notation (TARGET__n).', &
+ &       'The key at fault : '//TRIM(key_str),' ')
+      ENDIF
+!-
+      nbve = nb_lastkey
+      nbve = nbve+1
+      WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      DO WHILE (blk > 0)
+!-
+!------ Save the content of target__nbve
+!-
+        fichier(nb_lines) = tmp_str(1:blk)
+        new_key = &
+ &       key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+        targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+        fromfile(nb_lines) = current
+!-
+        tmp_str = TRIM(ADJUSTL(tmp_str(blk+1:LEN_TRIM(tmp_str))))
+        blk = INDEX(TRIM(tmp_str),' ')
+!-
+        IF (nb_lines+1 > i_txtsize) THEN
+          CALL getin_alloctxt ()
+        ENDIF
+        nb_lines = nb_lines+1
+        nbve = nbve+1
+        WRITE(UNIT=cnt,FMT=c_i_fmt) nbve
+!-
+      ENDDO
+!-
+!---- Save the content of the last target
+!-
+      fichier(nb_lines) = tmp_str(1:LEN_TRIM(tmp_str))
+      new_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      targetlist(nb_lines) = new_key(1:MIN(LEN_TRIM(new_key),l_n))
+      fromfile(nb_lines) = current
+!-
+      last_key = &
+ &      key_str(1:MIN(LEN_TRIM(key_str),l_n-n_d_fmt-2))//'__'//cnt
+      nb_lastkey = nbve
+!-
+    ENDIF
+!-
+  ENDIF
+!---------------------------
+END SUBROUTINE getin_decrypt
+!-
+!===
+!-
+SUBROUTINE getin_checkcohe ()
+!---------------------------------------------------------------------
+!- This subroutine checks for redundancies.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: line,n_k,k
+!---------------------------------------------------------------------
+  DO line=1,nb_lines-1
+!-
+    n_k = 0
+    DO k=line+1,nb_lines
+      IF (TRIM(targetlist(line)) == TRIM(targetlist(k))) THEN
+        n_k = k
+        EXIT
+      ENDIF
+    ENDDO
+!---
+!-- IF we have found it we have a problem to solve.
+!---
+    IF (n_k > 0) THEN
+      WRITE(*,*) 'COUNT : ',n_k
+      WRITE(*,*) &
+ &  'getin_checkcohe : Found a problem on key ',TRIM(targetlist(line))
+      WRITE(*,*) &
+ &  'getin_checkcohe : The following values were encoutered :'
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(line)),' == ',fichier(line)
+      WRITE(*,*) &
+ &  '                ',TRIM(targetlist(k)),' == ',fichier(k)
+      WRITE(*,*) &
+ &  'getin_checkcohe : We will keep only the last value'
+      targetlist(line) = ' '
+    ENDIF
+  ENDDO
+!-----------------------------
+END SUBROUTINE getin_checkcohe
+!-
+!===
+!-
+SUBROUTINE getin_skipafew (unit,out_string,eof,nb_lastkey)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: unit,eof,nb_lastkey
+  CHARACTER(LEN=100) :: dummy
+  CHARACTER(LEN=100) :: out_string
+  CHARACTER(LEN=1) :: first
+!---------------------------------------------------------------------
+  first="#"
+  eof = 0
+  out_string = "    "
+!-
+  DO WHILE (first == "#")
+    READ (UNIT=unit,FMT='(A)',ERR=9998,END=7778) dummy
+    dummy = TRIM(ADJUSTL(dummy))
+    first=dummy(1:1)
+    IF (first == "#") THEN
+      nb_lastkey = 0
+    ENDIF
+  ENDDO
+  out_string=dummy
+!-
+  RETURN
+!-
+9998 CONTINUE
+  CALL ipslerr (3,'getin_skipafew','Error while reading file',' ',' ')
+!-
+7778 CONTINUE
+  eof = 1
+!----------------------------
+END SUBROUTINE getin_skipafew
+!-
+!===
+!-
+SUBROUTINE getin_allockeys ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  IF (keymemsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) memslabs
+    ALLOCATE(key_tab(memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    nb_keys = 0
+    keymemsize = memslabs
+    key_tab(:)%keycompress = -1
+!---
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize
+    ALLOCATE(tmp_key_tab(keymemsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate tmp_key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    WRITE (UNIT=c_tmp,FMT=*) keymemsize+memslabs
+    tmp_key_tab(1:keymemsize) = key_tab(1:keymemsize)
+    DEALLOCATE(key_tab)
+    ALLOCATE(key_tab(keymemsize+memslabs),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_allockeys', &
+ &     'Can not allocate key_tab', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+    ENDIF
+    key_tab(:)%keycompress = -1
+    key_tab(1:keymemsize) = tmp_key_tab(1:keymemsize)
+    DEALLOCATE(tmp_key_tab)
+    keymemsize = keymemsize+memslabs
+  ENDIF
+!-----------------------------
+END SUBROUTINE getin_allockeys
+!-
+!===
+!-
+SUBROUTINE getin_allocmem (type,len_wanted)
+!---------------------------------------------------------------------
+!- Allocate the memory of the data base for all 4 types of memory
+!- INTEGER / REAL / CHARACTER / LOGICAL
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: type,len_wanted
+!-
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+  REAL,ALLOCATABLE :: tmp_real(:)
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_char(:)
+  LOGICAL,ALLOCATABLE :: tmp_logic(:)
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp
+!---------------------------------------------------------------------
+  SELECT CASE (type)
+  CASE(k_i)
+    IF (i_memsize == 0) THEN
+      ALLOCATE(i_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_memsize=memslabs
+    ELSE
+      ALLOCATE(tmp_int(i_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_int', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_int(1:i_memsize) = i_mem(1:i_memsize)
+      DEALLOCATE(i_mem)
+      ALLOCATE(i_mem(i_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) i_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'i_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      i_mem(1:i_memsize) = tmp_int(1:i_memsize)
+      i_memsize = i_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_int)
+    ENDIF
+  CASE(k_r)
+    IF (r_memsize == 0) THEN
+      ALLOCATE(r_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_memsize =  memslabs
+    ELSE
+      ALLOCATE(tmp_real(r_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_real', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_real(1:r_memsize) = r_mem(1:r_memsize)
+      DEALLOCATE(r_mem)
+      ALLOCATE(r_mem(r_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) r_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'r_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      r_mem(1:r_memsize) = tmp_real(1:r_memsize)
+      r_memsize = r_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_real)
+    ENDIF
+  CASE(k_c)
+    IF (c_memsize == 0) THEN
+      ALLOCATE(c_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_char(c_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_char', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_char(1:c_memsize) = c_mem(1:c_memsize)
+      DEALLOCATE(c_mem)
+      ALLOCATE(c_mem(c_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) c_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'c_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      c_mem(1:c_memsize) = tmp_char(1:c_memsize)
+      c_memsize = c_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_char)
+    ENDIF
+  CASE(k_l)
+    IF (l_memsize == 0) THEN
+      ALLOCATE(l_mem(memslabs),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) memslabs
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_memsize = memslabs
+    ELSE
+      ALLOCATE(tmp_logic(l_memsize),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to allocate tmp_logic', &
+ &       'to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      tmp_logic(1:l_memsize) = l_mem(1:l_memsize)
+      DEALLOCATE(l_mem)
+      ALLOCATE(l_mem(l_memsize+MAX(memslabs,len_wanted)),stat=ier)
+      IF (ier /= 0) THEN
+        WRITE (UNIT=c_tmp,FMT=*) l_memsize+MAX(memslabs,len_wanted)
+        CALL ipslerr (3,'getin_allocmem', &
+ &       'Unable to re-allocate db-memory', &
+ &       'l_mem to size '//TRIM(ADJUSTL(c_tmp)),' ')
+      ENDIF
+      l_mem(1:l_memsize) = tmp_logic(1:l_memsize)
+      l_memsize = l_memsize+MAX(memslabs,len_wanted)
+      DEALLOCATE(tmp_logic)
+    ENDIF
+  CASE DEFAULT
+    CALL ipslerr (3,'getin_allocmem','Unknown type of data',' ',' ')
+  END SELECT
+!----------------------------
+END SUBROUTINE getin_allocmem
+!-
+!===
+!-
+SUBROUTINE getin_alloctxt ()
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=100),ALLOCATABLE :: tmp_fic(:)
+  CHARACTER(LEN=l_n),ALLOCATABLE :: tmp_tgl(:)
+  INTEGER,ALLOCATABLE :: tmp_int(:)
+!-
+  INTEGER :: ier
+  CHARACTER(LEN=20) :: c_tmp1,c_tmp2
+!---------------------------------------------------------------------
+  IF (i_txtsize == 0) THEN
+!---
+!-- Nothing exists in memory arrays and it is easy to do.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtslab
+    ALLOCATE(fichier(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(targetlist(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(fromfile(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    ALLOCATE(compline(i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+!---
+    nb_lines = 0
+    i_txtsize = i_txtslab
+  ELSE
+!---
+!-- There is something already in the memory,
+!-- we need to transfer and reallocate.
+!---
+    WRITE (UNIT=c_tmp1,FMT=*) i_txtsize
+    WRITE (UNIT=c_tmp2,FMT=*) i_txtsize+i_txtslab
+    ALLOCATE(tmp_fic(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_fic', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_fic(1:i_txtsize) = fichier(1:i_txtsize)
+    DEALLOCATE(fichier)
+    ALLOCATE(fichier(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fichier', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fichier(1:i_txtsize) = tmp_fic(1:i_txtsize)
+    DEALLOCATE(tmp_fic)
+!---
+    ALLOCATE(tmp_tgl(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_tgl', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_tgl(1:i_txtsize) = targetlist(1:i_txtsize)
+    DEALLOCATE(targetlist)
+    ALLOCATE(targetlist(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate targetlist', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    targetlist(1:i_txtsize) = tmp_tgl(1:i_txtsize)
+    DEALLOCATE(tmp_tgl)
+!---
+    ALLOCATE(tmp_int(i_txtsize),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate tmp_int', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp1)),' ')
+    ENDIF
+    tmp_int(1:i_txtsize) = fromfile(1:i_txtsize)
+    DEALLOCATE(fromfile)
+    ALLOCATE(fromfile(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate fromfile', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    fromfile(1:i_txtsize) = tmp_int(1:i_txtsize)
+!---
+    tmp_int(1:i_txtsize) = compline(1:i_txtsize)
+    DEALLOCATE(compline)
+    ALLOCATE(compline(i_txtsize+i_txtslab),stat=ier)
+    IF (ier /= 0) THEN
+      CALL ipslerr (3,'getin_alloctxt', &
+ &     'Can not allocate compline', &
+ &     'to size '//TRIM(ADJUSTL(c_tmp2)),' ')
+    ENDIF
+    compline(1:i_txtsize) = tmp_int(1:i_txtsize)
+    DEALLOCATE(tmp_int)
+!---
+    i_txtsize = i_txtsize+i_txtslab
+  ENDIF
+!----------------------------
+END SUBROUTINE getin_alloctxt
+!-
+!===
+!-
+SUBROUTINE getin_dump (fileprefix)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(*),OPTIONAL :: fileprefix
+!-
+  CHARACTER(LEN=80) :: usedfileprefix
+  INTEGER :: ikey,if,iff,iv
+  CHARACTER(LEN=20) :: c_tmp
+  CHARACTER(LEN=100) :: tmp_str,used_filename
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (PRESENT(fileprefix)) THEN
+    usedfileprefix = fileprefix(1:MIN(LEN_TRIM(fileprefix),80))
+  ELSE
+    usedfileprefix = "used"
+  ENDIF
+!-
+  DO if=1,nbfiles
+!---
+    used_filename = TRIM(usedfileprefix)//'_'//TRIM(filelist(if))
+    IF (check) THEN
+      WRITE(*,*) &
+ &      'GETIN_DUMP : opens file : ',TRIM(used_filename),' if = ',if
+      WRITE(*,*) 'GETIN_DUMP : NUMBER OF KEYS : ',nb_keys
+    ENDIF
+    OPEN (UNIT=22,FILE=used_filename)
+!---
+!-- If this is the first file we need to add the list
+!-- of file which belong to it
+    IF ( (if == 1).AND.(nbfiles > 1) ) THEN
+      WRITE(22,*) '# '
+      WRITE(22,*) '# This file is linked to the following files :'
+      WRITE(22,*) '# '
+      DO iff=2,nbfiles
+        WRITE(22,*) 'INCLUDEDEF = ',TRIM(filelist(iff))
+      ENDDO
+      WRITE(22,*) '# '
+    ENDIF
+!---
+    DO ikey=1,nb_keys
+!-----
+!---- Is this key from this file ?
+      IF (key_tab(ikey)%keyfromfile == if) THEN
+!-------
+!------ Write some comments
+        WRITE(22,*) '#'
+        SELECT CASE (key_tab(ikey)%keystatus)
+        CASE(1)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file)
+        CASE(2)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr),' are all defaults.'
+        CASE(3)
+          WRITE(22,*) '# Values of ', &
+ &          TRIM(key_tab(ikey)%keystr), &
+ &          ' are a mix of ',TRIM(def_file),' and defaults.'
+        CASE DEFAULT
+          WRITE(22,*) '# Dont know from where the value of ', &
+ &          TRIM(key_tab(ikey)%keystr),' comes.'
+        END SELECT
+        WRITE(22,*) '#'
+!-------
+!------ Write the values
+        SELECT CASE (key_tab(ikey)%keytype)
+        CASE(k_i)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+ &              ' * ',i_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',i_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_r)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (key_tab(ikey)%keycompress < 0) THEN
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart)
+            ELSE
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',key_tab(ikey)%keycompress, &
+                   & ' * ',r_mem(key_tab(ikey)%keymemstart)
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr),'__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',r_mem(key_tab(ikey)%keymemstart+iv)
+            ENDDO
+          ENDIF
+        CASE(k_c)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            tmp_str = c_mem(key_tab(ikey)%keymemstart)
+            WRITE(22,*) TRIM(key_tab(ikey)%keystr), &
+ &              ' = ',TRIM(tmp_str)
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              tmp_str = c_mem(key_tab(ikey)%keymemstart+iv)
+              WRITE(22,*) &
+ &              TRIM(key_tab(ikey)%keystr), &
+ &              '__',TRIM(ADJUSTL(c_tmp)), &
+ &              ' = ',TRIM(tmp_str)
+            ENDDO
+          ENDIF
+        CASE(k_l)
+          IF (key_tab(ikey)%keymemlen == 1) THEN
+            IF (l_mem(key_tab(ikey)%keymemstart)) THEN
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = TRUE '
+            ELSE
+              WRITE(22,*) TRIM(key_tab(ikey)%keystr),' = FALSE '
+            ENDIF
+          ELSE
+            DO iv=0,key_tab(ikey)%keymemlen-1
+              WRITE(UNIT=c_tmp,FMT=c_i_fmt) iv+1
+              IF (l_mem(key_tab(ikey)%keymemstart+iv)) THEN
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = TRUE '
+              ELSE
+                WRITE(22,*) TRIM(key_tab(ikey)%keystr),'__', &
+ &                          TRIM(ADJUSTL(c_tmp)),' = FALSE '
+              ENDIF
+            ENDDO
+          ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'getin_dump', &
+ &         'Unknown type for variable '//TRIM(key_tab(ikey)%keystr), &
+ &         ' ',' ')
+        END SELECT
+      ENDIF
+    ENDDO
+!-
+    CLOSE(UNIT=22)
+!-
+  ENDDO
+!------------------------
+END SUBROUTINE getin_dump
+!===
+SUBROUTINE get_qtyp (k_typ,c_vtyp,i_v,r_v,c_v,l_v)
+!---------------------------------------------------------------------
+!- Returns the type of the argument (mutually exclusive)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(OUT) :: k_typ
+  CHARACTER(LEN=*),INTENT(OUT) :: c_vtyp
+  INTEGER,DIMENSION(:),OPTIONAL          :: i_v
+  REAL,DIMENSION(:),OPTIONAL             :: r_v
+  LOGICAL,DIMENSION(:),OPTIONAL          :: l_v
+  CHARACTER(LEN=*),DIMENSION(:),OPTIONAL :: c_v
+!---------------------------------------------------------------------
+  k_typ = 0
+  IF (COUNT((/PRESENT(i_v),PRESENT(r_v),PRESENT(c_v),PRESENT(l_v)/)) &
+ &    /= 1) THEN
+    CALL ipslerr (3,'get_qtyp', &
+ &   'Invalid number of optional arguments','(/= 1)',' ')
+  ENDIF
+!-
+  IF     (PRESENT(i_v)) THEN
+    k_typ = k_i
+    c_vtyp = 'INTEGER'
+  ELSEIF (PRESENT(r_v)) THEN
+    k_typ = k_r
+    c_vtyp = 'REAL'
+  ELSEIF (PRESENT(c_v)) THEN
+    k_typ = k_c
+    c_vtyp = 'CHARACTER'
+  ELSEIF (PRESENT(l_v)) THEN
+    k_typ = k_l
+    c_vtyp = 'LOGICAL'
+  ENDIF
+!----------------------
+END SUBROUTINE get_qtyp
+!===
+SUBROUTINE get_findkey (i_tab,c_key,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a key in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   i_tab  : 1 -> search in key_tab(1:nb_keys)%keystr
+!-            2 -> search in targetlist(1:nb_lines)
+!-   c_key  : Name of the key we are looking for
+!- OUTPUT
+!-   pos    : -1 if key not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in) :: i_tab
+  CHARACTER(LEN=*),INTENT(in) :: c_key
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: ikey_max,ikey
+  CHARACTER(LEN=l_n) :: c_q_key
+!---------------------------------------------------------------------
+  pos = -1
+  IF     (i_tab == 1) THEN
+    ikey_max = nb_keys
+  ELSEIF (i_tab == 2) THEN
+    ikey_max = nb_lines
+  ELSE
+    ikey_max = 0
+  ENDIF
+  IF ( ikey_max > 0 ) THEN
+    DO ikey=1,ikey_max
+      IF (i_tab == 1) THEN
+        c_q_key = key_tab(ikey)%keystr
+      ELSE
+        c_q_key = targetlist(ikey)
+      ENDIF
+      IF (TRIM(c_q_key) == TRIM(c_key)) THEN
+        pos = ikey
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-------------------------
+END SUBROUTINE get_findkey
+!===
+!------------------
+END MODULE getincom
Index: vendors/IOIPSL/src/histcom.f90
===================================================================
--- vendors/IOIPSL/src/histcom.f90	(revision 9621)
+++ vendors/IOIPSL/src/histcom.f90	(revision 9621)
@@ -0,0 +1,2501 @@
+MODULE histcom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+  USE netcdf
+  USE nc4interface ! needed to allow compilation with netcdf3 libraries
+!-
+  USE stringop, ONLY : nocomma,cmpblank,findpos,find_str,strlowercase
+  USE mathelp,  ONLY : mathop,moycum,buildop
+  USE fliocom,  ONLY : flio_dom_file,flio_dom_att
+  USE calendar
+  USE errioipsl, ONLY : ipslerr,ipsldbg
+!-
+  IMPLICIT NONE
+!-
+  PRIVATE
+  PUBLIC :: histbeg,histdef,histhori,histvert,histend, &
+ &          histwrite,histclo,histsync,ioconf_modname
+!---------------------------------------------------------------------
+!- Some confusing vocabulary in this code !
+!- =========================================
+!-
+!- A REGULAR grid is a grid which is i,j indexes
+!- and thus it is stored in a 2D matrix.
+!- This is opposed to a IRREGULAR grid which is only in a vector
+!- and where we do not know which neighbors we have.
+!- As a consequence we need the bounds for each grid-cell.
+!-
+!- A RECTILINEAR grid is a special case of a regular grid
+!- in which all longitudes for i constant are equal
+!- and all latitudes for j constant.
+!- In other words we do not need the full 2D matrix
+!- to describe the grid, just two vectors.
+!---------------------------------------------------------------------
+!-
+  INTERFACE histbeg
+    MODULE PROCEDURE histb_reg1d,histb_reg2d,histb_irreg
+  END INTERFACE
+!-
+  INTERFACE histhori
+    MODULE PROCEDURE histh_reg1d,histh_reg2d,histh_irreg
+  END INTERFACE
+!-
+  INTERFACE histwrite
+!---------------------------------------------------------------------
+!- The "histwrite" routines will give the data to the I/O system.
+!- It will trigger the operations to be performed,
+!- and the writting to the file if needed
+!-
+!- We test for the work to be done at this time here so that at a
+!- later stage we can call different operation and write subroutine
+!- for the REAL and INTEGER interfaces
+!-
+!- INPUT
+!- idf      : The ID of the file on which this variable is to be,
+!-            written. The variable should have been defined in
+!-            this file before.
+!- pvarname : The short name of the variable
+!- pitau    : Current timestep
+!- pdata    : The variable, I mean the real data !
+!- nbindex  : The number of indexes provided. If it is equal to
+!-            the size of the full field as provided in histdef
+!-            then nothing is done.
+!- nindex   : The indices used to expand the variable (pdata)
+!-            onto the full field.
+!---------------------------------------------------------------------
+!- histwrite - we have to prepare different type of fields :
+!-             real and integer, 1,2 or 3D
+    MODULE PROCEDURE histwrite_r1d,histwrite_r2d,histwrite_r3d
+  END INTERFACE
+!-
+! Fixed parameter
+!-
+  INTEGER,PARAMETER :: nb_files_max=20,nb_var_max=400, &
+ &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10
+  REAL,PARAMETER :: missing_val=nf90_fill_real
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  hist_r4=nf90_real4, hist_r8=nf90_real8
+!-
+! Variable derived type
+!-
+TYPE T_D_V
+  INTEGER :: ncvid
+  INTEGER :: nbopp
+  CHARACTER(LEN=20)  :: v_name,unit_name
+  CHARACTER(LEN=256) :: title,std_name
+  CHARACTER(LEN=80)  :: fullop
+  CHARACTER(LEN=7)   :: topp
+  CHARACTER(LEN=7),DIMENSION(nbopp_max) :: sopp
+  REAL,DIMENSION(nbopp_max) :: scal
+!-External type (for R4/R8)
+  INTEGER :: v_typ
+!-Sizes of the associated grid and zommed area
+  INTEGER,DIMENSION(3) :: scsize,zorig,zsize
+!-Sizes for the data as it goes through the various math operations
+  INTEGER,DIMENSION(3) :: datasz_in = -1
+  INTEGER :: datasz_max = -1
+!-
+  INTEGER :: h_axid,z_axid,t_axid
+!-
+  REAL,DIMENSION(2) :: hist_minmax
+  LOGICAL :: hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE.
+!-Book keeping of the axes
+  INTEGER :: tdimid,tbndid=-1,tax_last
+  LOGICAL :: l_bnd
+  CHARACTER(LEN=40) :: tax_name
+!-
+  REAL :: freq_opp,freq_wrt
+  INTEGER :: &
+ &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt
+!- For future optimization
+  REAL,POINTER,DIMENSION(:) :: t_bf
+!#  REAL,ALLOCATABLE,DIMENSION(:) :: V_1_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:) :: V_2_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:,:) :: V_3_D
+END TYPE T_D_V
+!-
+! File derived type
+!-
+TYPE :: T_D_F
+!-NETCDF IDs for file
+  INTEGER :: ncfid=-1
+!-Time variables
+  INTEGER :: itau0=0
+  REAL :: date0,deltat
+!-Counter of elements (variables, time-horizontal-vertical axis
+  INTEGER :: n_var=0,n_tax=0,n_hax=0,n_zax=0
+!-NETCDF dimension IDs for time-[time_bounds]-longitude-latitude
+  INTEGER :: tid,bid,xid,yid
+!-General definitions in the NETCDF file
+  INTEGER,DIMENSION(2) :: full_size=0,slab_ori,slab_siz
+!-The horizontal axes
+  CHARACTER(LEN=25),DIMENSION(nb_hax_max,2) :: hax_name
+!-The vertical axes
+  INTEGER,DIMENSION(nb_zax_max) :: zax_size,zax_ids
+  CHARACTER(LEN=20),DIMENSION(nb_zax_max) :: zax_name
+!-
+  LOGICAL :: regular=.TRUE.
+!-DOMAIN ID
+  INTEGER :: dom_id_svg=-1
+!-
+  TYPE(T_D_V),DIMENSION(nb_var_max) :: W_V
+END TYPE T_D_F
+!-
+TYPE(T_D_F),DIMENSION(nb_files_max),SAVE :: W_F
+!-
+! A list of functions which require special action
+! (Needs to be updated when functions are added
+!  but they are well located here)
+!-
+  CHARACTER(LEN=30),SAVE :: fuchnbout = 'scatter, fill'
+!- Some configurable variables with locks
+  CHARACTER(LEN=80),SAVE :: model_name='An IPSL model'
+  LOGICAL,SAVE :: lock_modname=.FALSE.
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE histb_reg1d                 &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for 1D regular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim),INTENT(IN) :: plon
+  REAL,DIMENSION(pjm),INTENT(IN) :: plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (1,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d=plon,y_1d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy, &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_reg1d
+!===
+SUBROUTINE histb_reg2d &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for 2D regular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim,pjm
+  REAL,DIMENSION(pim,pjm),INTENT(IN) :: plon,plat
+  INTEGER,INTENT(IN):: par_orix,par_szx,par_oriy,par_szy
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (2,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_2d=plon,y_2d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy,    &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_reg2d
+!===
+SUBROUTINE histb_irreg &
+ &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds, &
+ &   pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- histbeg for irregular horizontal coordinates (see histb_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: pfilename
+  INTEGER,INTENT(IN) :: pim
+  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (3,pfilename,pim,pim,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds, &
+ &  domain_id=domain_id,mode=mode,snc4chunks=snc4chunks)
+!-------------------------
+END SUBROUTINE histb_irreg
+!===
+SUBROUTINE histb_all &
+ & (k_typ,nc_name,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d,y_1d,x_2d,y_2d,k_orx,k_szx,k_ory,k_szy, &
+ &  x_bnds,y_bnds,domain_id,mode,snc4chunks)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine initializes a netcdf file and returns the ID.
+!- It will set up the geographical space on which the data will be
+!- stored and offers the possibility of seting a zoom.
+!- In the case of irregular grids, all the data comes in as vectors
+!- and for the grid we have the coordinates of the 4 corners.
+!- It also gets the global parameters into the I/O subsystem.
+!-
+!- INPUT
+!-
+!- k_typ    : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- nc_name  : Name of the netcdf file to be created
+!- pim      : Size of arrays in longitude direction
+!- pjm      : Size of arrays in latitude direction (pjm=pim for type 3)
+!-
+!- pitau0   : time step at which the history tape starts
+!- pdate0   : The Julian date at which the itau was equal to 0
+!- pdeltat  : Time step, in seconds, of the counter itau
+!-            used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid  : Identifier of the horizontal grid
+!- idf      : Identifier of the file
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For regular grid (reg1d or reg2d),
+!- the next 4 arguments allow to define a horizontal zoom
+!- for this file. It is assumed that all variables to come
+!- have the same index space. This can not be assumed for
+!- the z axis and thus we define the zoom in histdef.
+!- k_orx  : Origin of the slab of data within the X axis (pim)
+!- k_szx  : Size of the slab of data in X
+!- k_ory  : Origin of the slab of data within the Y axis (pjm)
+!- k_szy  : Size of the slab of data in Y
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!-
+!- For all grids.
+!-
+!- domain_id  : Domain identifier
+!-
+!- mode       : String of (case insensitive) blank-separated words
+!-              defining the mode used to create the file.
+!-              Supported keywords : 32, 64
+!-              "32/64" defines the offset mode.
+!-              The default offset mode is 64 bits.
+!-              Keywords "NETCDF4" and "CLASSIC" are reserved
+!-              for future use.
+!-
+!- snc4chunks    : Structure containing chunk partitioning parameters
+!-              for 4-D variables and a logical switch to toggle
+!-              between netcdf3 o/p (false) and netcdf4 chunked
+!-              and compressed o/p (true)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  CHARACTER(LEN=*),INTENT(IN) :: nc_name
+  INTEGER,INTENT(IN) :: pim,pjm
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  INTEGER,INTENT(IN),OPTIONAL :: k_orx,k_szx,k_ory,k_szy
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!-
+  INTEGER :: nfid,iret,m_c
+  CHARACTER(LEN=120) :: file
+  CHARACTER(LEN=30) :: timenow
+  CHARACTER(LEN=11) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histb_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histb_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histb_irreg'
+  ELSE
+    CALL ipslerr (3,"histbeg", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 0.0"
+!-
+! Search for a free index
+!-
+  idf = -1
+  DO nfid=1,nb_files_max
+    IF (W_F(nfid)%ncfid < 0) THEN
+      idf = nfid; EXIT;
+    ENDIF
+  ENDDO
+  IF (idf < 0) THEN
+    CALL ipslerr (3,"histbeg", &
+   &  'Table of files too small. You should increase nb_files_max', &
+   &  'in histcom.f90 in order to accomodate all these files',' ')
+  ENDIF
+!-
+! 1.0 Transfering into the common for future use
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  W_F(idf)%itau0  = pitau0
+  W_F(idf)%date0  = pdate0
+  W_F(idf)%deltat = pdeltat
+!-
+! 2.0 Initializes all variables for this file
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  W_F(idf)%n_var = 0
+  W_F(idf)%n_tax = 0
+  W_F(idf)%n_hax = 0
+  W_F(idf)%n_zax = 0
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%slab_ori(1:2) = (/ k_orx,k_ory /)
+    W_F(idf)%slab_siz(1:2)  = (/ k_szx,k_szy /)
+  ELSE
+    W_F(idf)%slab_ori(1:2) = (/ 1,1 /)
+    W_F(idf)%slab_siz(1:2) = (/ pim,1 /)
+  ENDIF
+!-
+! 3.0 Opening netcdf file and defining dimensions
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+! Add DOMAIN number and ".nc" suffix in file name if needed
+!-
+  file = nc_name
+  CALL flio_dom_file (file,domain_id)
+!-
+! Check the mode
+!? See fliocom for HDF4 ????????????????????????????????????????????????
+!-
+  IF (PRESENT(mode)) THEN
+    SELECT CASE (TRIM(mode))
+    CASE('32')
+      m_c = NF90_CLOBBER
+    CASE('64')
+      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+    CASE DEFAULT
+      CALL ipslerr (3,"histbeg", &
+ &      'Invalid argument mode for file :',TRIM(file), &
+ &      'Supported values are 32 or 64')
+    END SELECT
+  ELSE
+    m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+  ENDIF
+!-
+  IF (PRESENT(snc4chunks)) THEN
+    IF (snc4chunks%luse) CALL get_nf90_symbol("NF90_HDF5", m_c)
+  ENDIF
+!-
+! Create file
+!-
+  iret = NF90_CREATE(file,m_c,nfid)
+!-
+  IF     (k_typ == 1) THEN
+    iret = NF90_DEF_DIM(nfid,'lon',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'lat',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 2) THEN
+    iret = NF90_DEF_DIM(nfid,'x',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'y',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 3) THEN
+    iret = NF90_DEF_DIM(nfid,'x',pim,W_F(idf)%xid)
+    W_F(idf)%yid = W_F(idf)%xid
+  ENDIF
+!-
+! 4.0 Declaring the geographical coordinates and other attributes
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'file_name',TRIM(file))
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'production',TRIM(model_name))
+  lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! 5.0 Saving some important information on this file in the common
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 5.0"
+!-
+  IF (PRESENT(domain_id)) THEN
+    W_F(idf)%dom_id_svg = domain_id
+  ENDIF
+  W_F(idf)%ncfid = nfid
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,pjm /)
+    W_F(idf)%regular=.TRUE.
+  ELSEIF (k_typ == 3) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,1 /)
+    W_F(idf)%regular=.FALSE.
+  ENDIF
+!-
+! 6.0 storing the geographical coordinates
+!-
+  IF     (k_typ == 1) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d)
+  ELSEIF (k_typ == 2) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_2d=x_2d,y_2d=y_2d)
+  ELSEIF (k_typ == 3) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pim,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d,x_bnds=x_bnds,y_bnds=y_bnds)
+  ENDIF
+!-----------------------
+END SUBROUTINE histb_all
+!===
+SUBROUTINE histh_reg1d &
+ &  (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 1d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (1,idf,pim,pjm,phname,phtitle,phid,x_1d=plon,y_1d=plat)
+!-------------------------
+END SUBROUTINE histh_reg1d
+!===
+SUBROUTINE histh_reg2d &
+ & (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 2d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:,:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (2,idf,pim,pjm,phname,phtitle,phid,x_2d=plon,y_2d=plat)
+!-------------------------
+END SUBROUTINE histh_reg2d
+!===
+SUBROUTINE histh_irreg &
+ & (idf,pim,plon,plon_bounds,plat,plat_bounds,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for irregular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim
+  REAL,DIMENSION(:),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (3,idf,pim,pim,phname,phtitle,phid, &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds)
+!-------------------------
+END SUBROUTINE histh_irreg
+!===
+SUBROUTINE histh_all &
+ & (k_typ,idf,pim,pjm,phname,phtitle,phid, &
+ &  x_1d,y_1d,x_2d,y_2d,x_bnds,y_bnds)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine is made to declare a new horizontal grid.
+!- It has to have the same number of points as
+!- the original and thus in this routine we will only
+!- add two variable (longitude and latitude).
+!- Any variable in the file can thus point to this pair
+!- through an attribute. This routine is very usefull
+!- to allow staggered grids.
+!-
+!- INPUT
+!-
+!- k_typ   : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- idf     : The id of the file to which the grid should be added
+!- pim     : Size in the longitude direction
+!- pjm     : Size in the latitude direction (pjm=pim for type 3)
+!- phname  : The name of grid
+!- phtitle : The title of the grid
+!-
+!- OUTPUT
+!-
+!- phid    : Id of the created grid
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+!-
+  CHARACTER(LEN=25) :: lon_name,lat_name
+  CHARACTER(LEN=30) :: lonbound_name,latbound_name
+  INTEGER :: i_s,i_e
+  INTEGER,DIMENSION(2) :: dims,dims_b
+  INTEGER :: nbbounds
+  INTEGER :: nlonidb,nlatidb,twoid
+  LOGICAL :: transp = .FALSE.
+  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans
+  REAL :: wmn,wmx
+  INTEGER :: nlonid,nlatid
+  INTEGER :: o_x,o_y,s_x,s_y
+  INTEGER :: iret,nfid
+  CHARACTER(LEN=11) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histh_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histh_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histh_irreg'
+  ELSE
+    CALL ipslerr (3,"histhori", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+! 1.0 Check that all fits in the buffers
+!-
+  IF (    (pim /= W_F(idf)%full_size(1)) &
+ &    .OR.(W_F(idf)%regular.AND.(pjm /= W_F(idf)%full_size(2)))  &
+ &    .OR.(.NOT.W_F(idf)%regular.AND.(W_F(idf)%full_size(2) /= 1)) ) THEN
+    CALL ipslerr (3,"histhori", &
+ &   'The new horizontal grid does not have the same size', &
+ &   'as the one provided to histbeg. This is not yet ', &
+ &   'possible in the hist package.')
+  ENDIF
+!-
+! 1.1 Create all the variables needed
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  IF (k_typ == 3) THEN
+    IF     (SIZE(x_bnds,DIM=1) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=2)
+      transp = .TRUE.
+    ELSEIF (SIZE(x_bnds,DIM=2) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=1)
+      transp = .FALSE.
+    ELSE
+      CALL ipslerr (3,"histhori", &
+ &     'The boundary variable does not have any axis corresponding', &
+ &     'to the size of the longitude or latitude variable','.')
+    ENDIF
+    ALLOCATE(bounds_trans(nbbounds,pim))
+    iret = NF90_DEF_DIM(nfid,'nbnd',nbbounds,twoid)
+    dims_b(1:2) = (/ twoid,W_F(idf)%xid /)
+  ENDIF
+!-
+  dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+!-
+  IF     (k_typ == 1) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'lon'
+      lat_name = 'lat'
+    ELSE
+      lon_name = 'lon_'//TRIM(phname)
+      lat_name = 'lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 2) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+    lonbound_name = TRIM(lon_name)//'_bounds'
+    latbound_name = TRIM(lat_name)//'_bounds'
+  ENDIF
+!-
+! 1.2 Save the informations
+!-
+  phid = W_F(idf)%n_hax+1
+  W_F(idf)%n_hax = phid
+  W_F(idf)%hax_name(phid,1:2) = (/ lon_name,lat_name /)
+!-
+! 2.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  i_s = 1;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_e = 1; wmn = MINVAL(x_1d); wmx = MAXVAL(x_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_e = 2; wmn = MINVAL(x_2d); wmx = MAXVAL(x_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lon_name,NF90_REAL4,dims(i_s:i_e),nlonid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlonid,'axis',"X")
+  ENDIF
+  iret = NF90_PUT_ATT(nfid,nlonid,'standard_name',"longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'long_name',"Longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 2.1 Longitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlonid,'bounds',TRIM(lonbound_name))
+    iret = NF90_DEF_VAR(nfid,lonbound_name,NF90_REAL4,dims_b(1:2),nlonidb)
+    iret = NF90_PUT_ATT(nfid,nlonidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lon_name))
+  ENDIF
+!-
+! 3.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+  i_e = 2;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_s = 2; wmn = MINVAL(y_1d); wmx = MAXVAL(y_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_s = 1; wmn = MINVAL(y_2d); wmx = MAXVAL(y_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lat_name,NF90_REAL4,dims(i_s:i_e),nlatid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlatid,'axis',"Y")
+  ENDIF
+!-
+  iret = NF90_PUT_ATT(nfid,nlatid,'standard_name',"latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'long_name',"Latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 3.1 Latitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlatid,'bounds',TRIM(latbound_name))
+    iret = NF90_DEF_VAR(nfid,latbound_name,NF90_REAL4,dims_b(1:2),nlatidb)
+    iret = NF90_PUT_ATT(nfid,nlatidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lat_name))
+  ENDIF
+!-
+  iret = NF90_ENDDEF(nfid)
+!-
+! 4.0 storing the geographical coordinates
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    o_x = W_F(idf)%slab_ori(1)
+    o_y = W_F(idf)%slab_ori(2)
+    s_x = W_F(idf)%slab_siz(1)
+    s_y = W_F(idf)%slab_siz(2)
+!---
+!-- Transfer the longitude and  the latitude
+!---
+    IF     (k_typ == 1) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid,x_1d(o_x:o_x+s_x-1))
+      iret = NF90_PUT_VAR(nfid,nlatid,y_1d(o_y:o_y+s_y-1))
+    ELSEIF (k_typ == 2) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid, &
+ &            x_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+      iret = NF90_PUT_VAR(nfid,nlatid, &
+ &            y_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+!---
+!-- Transfer the longitude and the longitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlonid,x_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(x_bnds)
+    ELSE
+      bounds_trans = x_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlonidb,bounds_trans(1:nbbounds,1:pim))
+!---
+!-- Transfer the latitude and the latitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlatid,y_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(y_bnds)
+    ELSE
+      bounds_trans = y_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlatidb,bounds_trans(1:nbbounds,1:pim))
+!---
+    DEALLOCATE(bounds_trans)
+  ENDIF
+!-
+  iret = NF90_REDEF(nfid)
+!-----------------------
+END SUBROUTINE histh_all
+!===
+SUBROUTINE histvert (idf,pzaxname,pzaxtitle,pzaxunit, &
+ &                   pzsize,pzvalues,pzaxid,pdirect)
+!---------------------------------------------------------------------
+!- This subroutine defines a vertical axis and returns it s id.
+!- It gives the user the possibility to the user to define many
+!- different vertical axes. For each variable defined with histdef a
+!- vertical axis can be specified with by it s ID.
+!-
+!- INPUT
+!-
+!- idf      : ID of the file the variable should be archived in
+!- pzaxname : Name of the vertical axis
+!- pzaxtitle: title of the vertical axis
+!- pzaxunit : Units of the vertical axis (no units if blank string)
+!- pzsize   : size of the vertical axis
+!- pzvalues : Coordinate values of the vetical axis
+!-
+!- pdirect  : is an optional argument which allows to specify the
+!-            the positive direction of the axis : up or down.
+!- OUTPUT
+!-
+!- pzaxid   : Returns the ID of the axis.
+!-            Note that this is not the netCDF ID !
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pzsize
+  CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle
+  REAL,INTENT(IN) :: pzvalues(pzsize)
+  INTEGER,INTENT(OUT) :: pzaxid
+  CHARACTER(LEN=*),INTENT(IN),OPTIONAL :: pdirect
+!-
+  INTEGER :: pos,iv,zdimid,zaxid_tmp
+  CHARACTER(LEN=70) :: str71
+  CHARACTER(LEN=20) :: direction
+  INTEGER :: iret,leng,nfid
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Verifications :
+!    Do we have enough space for an extra axis ?
+!    Is the name already in use ?
+!-
+  IF (l_dbg) WRITE(*,*) "histvert : 1.0 Verifications", &
+ &                      pzaxname,'---',pzaxunit,'---',pzaxtitle
+!-
+! Direction of the vertical axis. Can we get if from the user.
+!-
+  IF (PRESENT(pdirect)) THEN
+    direction = TRIM(pdirect)
+    CALL strlowercase (direction)
+  ELSE
+    direction = 'unknown'
+  ENDIF
+!-
+! Check the consistency of the attribute
+!-
+  IF (     PRESENT(pdirect)    &
+ &    .AND.(direction /= 'up') &
+ &    .AND.(direction /= 'down') ) THEN
+    direction = 'unknown'
+    CALL ipslerr (2,"histvert",&
+ & "The specified positive direction for the vertical axis is invalid.",&
+ & "The value must be up or down.","The attribute will not be written.")
+  ENDIF
+!-
+  IF (W_F(idf)%n_zax+1 > nb_zax_max) THEN
+    CALL ipslerr (3,"histvert", &
+   &  'Table of vertical axes too small. You should increase ',&
+   &  'nb_zax_max in histcom.f90 in order to accomodate all ', &
+   &  'these variables ')
+  ENDIF
+!-
+  iv = W_F(idf)%n_zax
+  IF (iv > 1) THEN
+    CALL find_str (W_F(idf)%zax_name(1:iv-1),pzaxname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    WRITE(str71,'("Check variable ",A," in file",I3)') &
+ &    TRIM(pzaxname),idf
+    CALL ipslerr (3,"histvert", &
+ &    "Vertical axis already exists",TRIM(str71), &
+ &    "Can also be a wrong file ID in another declaration")
+  ENDIF
+!-
+  iv = W_F(idf)%n_zax+1
+!-
+! 2.0 Add the information to the file
+!-
+  IF (l_dbg) &
+ &  WRITE(*,*) "histvert : 2.0 Add the information to the file"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_DEF_DIM (nfid,pzaxname(1:leng),pzsize,zaxid_tmp)
+  iret = NF90_DEF_VAR (nfid,pzaxname(1:leng),NF90_REAL4, &
+ &                     zaxid_tmp,zdimid)
+  iret = NF90_PUT_ATT (nfid,zdimid,'axis',"Z")
+  iret = NF90_PUT_ATT (nfid,zdimid,'standard_name',"model_level_number")
+  leng = MIN(LEN_TRIM(pzaxunit),20)
+  IF (leng > 0) THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'units',pzaxunit(1:leng))
+  ENDIF
+  IF (direction /= 'unknown') THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'positive',TRIM(direction))
+  ENDIF
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_min', &
+ &                     REAL(MINVAL(pzvalues(1:pzsize)),KIND=4))
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_max', &
+ &                     REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4))
+  leng = MIN(LEN_TRIM(pzaxname),20)
+  iret = NF90_PUT_ATT (nfid,zdimid,'title',pzaxname(1:leng))
+  leng = MIN(LEN_TRIM(pzaxtitle),80)
+  iret = NF90_PUT_ATT (nfid,zdimid,'long_name',pzaxtitle(1:leng))
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+  iret = NF90_PUT_VAR (nfid,zdimid,pzvalues(1:pzsize))
+!-
+  iret = NF90_REDEF (nfid)
+!-
+!- 3.0 add the information to the common
+!-
+  IF (l_dbg) &
+  &  WRITE(*,*) "histvert : 3.0 add the information to the common"
+!-
+  W_F(idf)%n_zax = iv
+  W_F(idf)%zax_size(iv) = pzsize
+  W_F(idf)%zax_name(iv) = pzaxname
+  W_F(idf)%zax_ids(iv) = zaxid_tmp
+  pzaxid = iv
+!----------------------
+END SUBROUTINE histvert
+!===
+SUBROUTINE histdef &
+ &  (idf,pvarname,ptitle,punit, &
+ &   pxsize,pysize,phoriid,pzsize,par_oriz,par_szz,pzid, &
+ &   xtype,popp,pfreq_opp,pfreq_wrt,var_range,standard_name)
+!---------------------------------------------------------------------
+!- With this subroutine each variable to be archived on the history
+!- tape should be declared.
+!-
+!- It gives the user the choise of operation
+!- to be performed on the variables, the frequency of this operation
+!- and finaly the frequency of the archiving.
+!-
+!- INPUT
+!-
+!- idf      : ID of the file the variable should be archived in
+!- pvarname : Name of the variable, short and easy to remember
+!- ptitle   : Full name of the variable
+!- punit    : Units of the variable (no units if blank string)
+!-
+!- The next 3 arguments give the size of that data
+!- that will be passed to histwrite. The zoom will be
+!- done there with the horizontal information obtained
+!- in histbeg and the vertical information to follow.
+!-
+!- pxsize   : Size in X direction (size of the data that will be
+!-            given to histwrite)
+!- pysize   : Size in Y direction
+!- phoriid  : ID of the horizontal axis
+!-
+!- The next two arguments give the vertical zoom to use.
+!-
+!- pzsize   : Size in Z direction (If 1 then no axis is declared
+!-            for this variable and pzid is not used)
+!- par_oriz : Off set of the zoom
+!- par_szz  : Size of the zoom
+!-
+!- pzid     : ID of the vertical axis to use. It has to have
+!-            the size of the zoom.
+!- xtype    : External netCDF type (hist_r4/hist_r8)
+!- popp     : Operation to be performed. The following options
+!-            exist today :
+!- inst : keeps instantaneous values for writting
+!- ave  : Computes the average from call between writes
+!- pfreq_opp: Frequency of this operation (in seconds)
+!- pfreq_wrt: Frequency at which the variable should be
+!-            written (in seconds)
+!- var_range: Range of the variable.
+!-            If the minimum is greater than the maximum,
+!-            the values will be calculated.
+!-
+!- VERSION
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pxsize,pysize,pzsize,pzid
+  INTEGER,INTENT(IN) :: par_oriz,par_szz,xtype,phoriid
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle
+  REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt
+  REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: standard_name
+!-
+  INTEGER :: iv
+  CHARACTER(LEN=70) :: str70,str71,str72
+  CHARACTER(LEN=20) :: tmp_name
+  CHARACTER(LEN=40) :: str40
+  CHARACTER(LEN=10) :: str10
+  CHARACTER(LEN=120) :: ex_topps
+  REAL :: un_an,un_jour,test_fopp,test_fwrt
+  INTEGER :: pos,buff_sz
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'
+!-
+  W_F(idf)%n_var = W_F(idf)%n_var+1
+  iv = W_F(idf)%n_var
+!-
+  IF (iv > nb_var_max) THEN
+    CALL ipslerr (3,"histdef", &
+   &  'Table of variables too small. You should increase nb_var_max',&
+   &  'in histcom.f90 in order to accomodate all these variables', &
+   &  ' ')
+  ENDIF
+!-
+! 1.0 Transfer informations on the variable to the common
+!     and verify that it does not already exist
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 1.0"
+!-
+  IF (iv > 1) THEN
+    CALL find_str (W_F(idf)%W_V(1:iv-1)%v_name,pvarname,pos)
+  ELSE
+    pos = 0
+  ENDIF
+!-
+  IF (pos > 0) THEN
+    str70 = "Variable already exists"
+    WRITE(str71,'("Check variable  ",a," in file",I3)') &
+ &    TRIM(pvarname),idf
+    str72 = "Can also be a wrong file ID in another declaration"
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%v_name = pvarname
+  W_F(idf)%W_V(iv)%title = ptitle
+  W_F(idf)%W_V(iv)%unit_name = punit
+  IF (PRESENT(standard_name)) THEN
+    W_F(idf)%W_V(iv)%std_name = standard_name
+  ELSE
+    W_F(idf)%W_V(iv)%std_name = ptitle
+  ENDIF
+  tmp_name = W_F(idf)%W_V(iv)%v_name
+!-
+! 1.1 decode the operations
+!-
+  W_F(idf)%W_V(iv)%fullop = popp
+  CALL buildop &
+ &  (TRIM(popp),ex_topps,W_F(idf)%W_V(iv)%topp,missing_val, &
+ &   W_F(idf)%W_V(iv)%sopp,W_F(idf)%W_V(iv)%scal, &
+ &   W_F(idf)%W_V(iv)%nbopp)
+!-
+! 1.2 If we have an even number of operations
+!     then we need to add identity
+!-
+  IF ( MOD(W_F(idf)%W_V(iv)%nbopp,2) == 0) THEN
+    W_F(idf)%W_V(iv)%nbopp = W_F(idf)%W_V(iv)%nbopp+1
+    W_F(idf)%W_V(iv)%sopp(W_F(idf)%W_V(iv)%nbopp) = 'ident'
+    W_F(idf)%W_V(iv)%scal(W_F(idf)%W_V(iv)%nbopp) = missing_val
+  ENDIF
+!-
+! 1.3 External type of the variable
+!-
+  IF (xtype == hist_r8) THEN
+    W_F(idf)%W_V(iv)%v_typ = hist_r8
+  ELSE
+    W_F(idf)%W_V(iv)%v_typ = hist_r4
+  ENDIF
+!-
+! 2.0 Put the size of the variable in the common and check
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, &
+ &    W_F(idf)%W_V(iv)%sopp(1:W_F(idf)%W_V(iv)%nbopp), &
+ &    W_F(idf)%W_V(iv)%scal(1:W_F(idf)%W_V(iv)%nbopp)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%scsize(1:3) = (/ pxsize,pysize,pzsize /)
+  W_F(idf)%W_V(iv)%zorig(1:3) = &
+ &  (/ W_F(idf)%slab_ori(1),W_F(idf)%slab_ori(2),par_oriz /)
+  W_F(idf)%W_V(iv)%zsize(1:3) = &
+ &  (/ W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2),par_szz /)
+!-
+! Is the size of the full array the same as that of the coordinates ?
+!-
+  IF (    (pxsize > W_F(idf)%full_size(1)) &
+ &    .OR.(pysize > W_F(idf)%full_size(2)) ) THEN
+!-
+    str70 = "The size of the variable is different "// &
+ &          "from the one of the coordinates"
+    WRITE(str71,'("Size of coordinates :",2I4)') &
+ &   W_F(idf)%full_size(1),W_F(idf)%full_size(2)
+    WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! Is the size of the zoom smaller than the coordinates ?
+!-
+  IF (    (W_F(idf)%full_size(1) < W_F(idf)%slab_siz(1)) &
+ &    .OR.(W_F(idf)%full_size(2) < W_F(idf)%slab_siz(2)) ) THEN
+    str70 = &
+ &   "Size of variable should be greater or equal to those of the zoom"
+    WRITE(str71,'("Size of XY zoom :",2I4)') &
+ &   W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2)
+    WRITE(str72,'("Size declared for variable ",A," :",2I4)') &
+ &   TRIM(tmp_name),pxsize,pysize
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 2.1 We store the horizontal grid information with minimal
+!     and a fall back onto the default grid
+!-
+  IF ( (phoriid > 0).AND.(phoriid <= W_F(idf)%n_hax) ) THEN
+    W_F(idf)%W_V(iv)%h_axid = phoriid
+  ELSE
+    W_F(idf)%W_V(iv)%h_axid = 1
+    CALL ipslerr (2,"histdef", &
+   &  'We use the default grid for variable as an invalide',&
+   &  'ID was provided for variable : ',TRIM(pvarname))
+  ENDIF
+!-
+! 2.2 Check the vertical coordinates if needed
+!-
+  IF (par_szz > 1) THEN
+!-
+!-- Does the vertical coordinate exist ?
+!-
+    IF (pzid > W_F(idf)%n_zax) THEN
+      WRITE(str70, &
+ &    '("The vertical coordinate chosen for variable ",A)') &
+ &     TRIM(tmp_name)
+      str71 = " Does not exist."
+      CALL ipslerr (3,"histdef",str70,str71," ")
+    ENDIF
+!-
+!-- Is the vertical size of the variable equal to that of the axis ?
+!-
+    IF (par_szz /= W_F(idf)%zax_size(pzid)) THEN
+      str70 = "The size of the zoom does not correspond "// &
+ &            "to the size of the chosen vertical axis"
+      WRITE(str71,'("Size of zoom in z :",I4)') par_szz
+      WRITE(str72,'("Size declared for axis ",A," :",I4)') &
+ &     TRIM(W_F(idf)%zax_name(pzid)),W_F(idf)%zax_size(pzid)
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+!-
+!-- Is the zoom smaller that the total size of the variable ?
+!-
+    IF (pzsize < par_szz) THEN
+      str70 = "The vertical size of variable "// &
+ &            "is smaller than that of the zoom."
+      WRITE(str71,'("Declared vertical size of data :",I5)') pzsize
+      WRITE(str72,'("Size of zoom for variable ",a," = ",I5)') &
+ &     TRIM(tmp_name),par_szz
+      CALL ipslerr (3,"histdef",str70,str71,str72)
+    ENDIF
+    W_F(idf)%W_V(iv)%z_axid = pzid
+  ELSE
+    W_F(idf)%W_V(iv)%z_axid = -99
+  ENDIF
+!-
+! 3.0 We get the size of the arrays histwrite will get
+!     and eventually allocate the time_buffer
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 3.0"
+  ENDIF
+!-
+  buff_sz = W_F(idf)%W_V(iv)%zsize(1) &
+ &         *W_F(idf)%W_V(iv)%zsize(2) &
+ &         *W_F(idf)%W_V(iv)%zsize(3)
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= "inst") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "once") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "never") )THEN
+    ALLOCATE(W_F(idf)%W_V(iv)%t_bf(buff_sz))
+    W_F(idf)%W_V(iv)%t_bf(:) = 0.
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 3.0 allocating time_buffer for", &
+ &      " idf = ",idf," iv = ",iv," size = ",buff_sz
+    ENDIF
+  ENDIF
+!-
+! 4.0 Transfer the frequency of the operations and check
+!     for validity. We have to pay attention to negative values
+!     of the frequency which indicate monthly time-steps.
+!     The strategy is to bring it back to seconds for the tests
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 4.0"
+!-
+  W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+  W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
+!-
+  CALL ioget_calendar(un_an,un_jour)
+  IF (pfreq_opp < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fopp = pfreq_opp*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fopp = pfreq_opp
+  ENDIF
+  IF (pfreq_wrt < 0) THEN
+    CALL ioget_calendar(un_an)
+    test_fwrt = pfreq_wrt*(-1.)*un_an/12.*un_jour
+  ELSE
+    test_fwrt = pfreq_wrt
+  ENDIF
+!-
+! 4.1 Frequency of operations and output should be larger than deltat !
+!-
+  IF (test_fopp < W_F(idf)%deltat) THEN
+    str70 = 'Frequency of operations should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_opp
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    W_F(idf)%W_V(iv)%freq_opp = W_F(idf)%deltat
+  ENDIF
+!-
+  IF (test_fwrt < W_F(idf)%deltat) THEN
+    str70 = 'Frequency of output should be larger than deltat'
+    WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
+ &   TRIM(tmp_name),pfreq_wrt
+    str72 = "PATCH : frequency set to deltat"
+!-
+    CALL ipslerr (2,"histdef",str70,str71,str72)
+!-
+    W_F(idf)%W_V(iv)%freq_wrt = W_F(idf)%deltat
+  ENDIF
+!-
+! 4.2 First the existence of the operation is tested and then
+!     its compaticility with the choice of frequencies
+!-
+  IF (TRIM(W_F(idf)%W_V(iv)%topp) == "inst") THEN
+    IF (test_fopp /= test_fwrt) THEN
+      str70 = 'For instantaneous output the frequency '// &
+ &            'of operations and output'
+      WRITE(str71, &
+ &     '("should be the same, this was not case for variable ",a)') &
+ &      TRIM(tmp_name)
+      str72 = "PATCH : The smalest frequency of both is used"
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      IF (test_fopp < test_fwrt) THEN
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_opp
+      ELSE
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
+      ENDIF
+    ENDIF
+  ELSE IF (INDEX(ex_topps,TRIM(W_F(idf)%W_V(iv)%topp)) > 0) THEN
+    IF (test_fopp > test_fwrt) THEN
+      str70 = 'For averages the frequency of operations '// &
+ &            'should be smaller or equal'
+      WRITE(str71, &
+ &     '("to that of output. It is not the case for variable ",a)') &
+ &     TRIM(tmp_name)
+      str72 = 'PATCH : The output frequency is used for both'
+      CALL ipslerr (2,"histdef",str70,str71,str72)
+      W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+    ENDIF
+  ELSE
+    WRITE (str70,'("Operation on variable ",A," is unknown")') &
+ &   TRIM(tmp_name)
+    WRITE (str71,'("operation requested is :",A)') &
+ &   W_F(idf)%W_V(iv)%topp
+    WRITE (str72,'("File ID :",I3)') idf
+    CALL ipslerr (3,"histdef",str70,str71,str72)
+  ENDIF
+!-
+! 5.0 Initialize other variables of the common
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 5.0"
+!-
+  W_F(idf)%W_V(iv)%hist_wrt_rng = (PRESENT(var_range))
+  IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+    W_F(idf)%W_V(iv)%hist_calc_rng = (var_range(1) > var_range(2))
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = &
+ &      (/ ABS(missing_val),-ABS(missing_val) /)
+    ELSE
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = var_range(1:2)
+    ENDIF
+  ENDIF
+!-
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt = W_F(idf)%itau0
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp_chk = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt_chk = W_F(idf)%itau0
+  W_F(idf)%W_V(iv)%nb_opp = 0
+  W_F(idf)%W_V(iv)%nb_wrt = 0
+!-
+! 6.0 Get the time axis for this variable
+!-
+  IF (l_dbg) WRITE(*,*) "histdef : 6.0"
+!-
+! No time axis for once, l_max, l_min or never operation
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= 'once')  &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'never') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_max') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_min') ) THEN
+    IF (TRIM(W_F(idf)%W_V(iv)%topp) == 'inst') THEN
+      str10 = 't_inst_'
+    ELSE
+      str10 = 't_op_'
+    ENDIF
+    IF (W_F(idf)%W_V(iv)%freq_wrt > 0) THEN
+      WRITE (UNIT=str40,FMT='(A,I8.8)') &
+&      TRIM(str10),INT(W_F(idf)%W_V(iv)%freq_wrt)
+    ELSE
+      WRITE (UNIT=str40,FMT='(A,I2.2,"month")') &
+&      TRIM(str10),ABS(INT(W_F(idf)%W_V(iv)%freq_wrt))
+    ENDIF
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_tax)%tax_name,str40,pos)
+    IF (pos < 0) THEN
+      W_F(idf)%n_tax = W_F(idf)%n_tax+1
+      W_F(idf)%W_V(iv)%l_bnd = &
+ &      (TRIM(W_F(idf)%W_V(iv)%topp) /= 'inst')
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_name = str40
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_last = 0
+      W_F(idf)%W_V(iv)%t_axid = W_F(idf)%n_tax
+    ELSE
+      W_F(idf)%W_V(iv)%t_axid = pos
+    ENDIF
+  ELSE
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----'
+    ENDIF
+    W_F(idf)%W_V(iv)%t_axid = -99
+  ENDIF
+!-
+! 7.0 prepare frequence of writing and operation
+!     for never or once operation
+!-
+  IF (    (TRIM(W_F(idf)%W_V(iv)%topp) == 'once')  &
+ &    .OR.(TRIM(W_F(idf)%W_V(iv)%topp) == 'never') ) THEN
+    W_F(idf)%W_V(iv)%freq_opp = 0.
+    W_F(idf)%W_V(iv)%freq_wrt = 0.
+  ENDIF
+!---------------------
+END SUBROUTINE histdef
+!===
+SUBROUTINE histend (idf, snc4chunks)
+!---------------------------------------------------------------------
+!- This subroutine end the decalaration of variables and sets the
+!- time axes in the netcdf file and puts it into the write mode.
+!-
+!- INPUT
+!-
+!- idf : ID of the file to be worked on
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf
+  TYPE(snc4_ctl), OPTIONAL,INTENT(IN) :: snc4chunks
+!-
+  INTEGER :: nfid,nvid,iret,ndim,iv,itx,ziv,itax,dim_cnt
+  INTEGER,DIMENSION(4) :: dims
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  REAL :: rtime0
+  CHARACTER(LEN=30) :: str30
+  CHARACTER(LEN=35) :: str35
+  CHARACTER(LEN=120) :: assoc
+  CHARACTER(LEN=70) :: str70
+  CHARACTER(LEN=3),DIMENSION(12) :: cal =   &
+ &  (/ 'JAN','FEB','MAR','APR','MAY','JUN', &
+ &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
+  CHARACTER(LEN=7) :: tmp_opp
+  LOGICAL :: l_b
+  LOGICAL :: l_dbg
+  INTEGER, DIMENSION(4) :: ichunksz    ! NETCDF4 chunk sizes
+  INTEGER :: ichunkalg, ishuffle,&
+             ideflate, ideflate_level
+  LOGICAL :: lchunk = .FALSE.   ! logical switch to activate chunking when appropriate
+!-
+  ! NetCDF4 chunking and compression parameters
+  ichunkalg = 0
+  ishuffle = 1
+  ideflate = 1
+  ideflate_level = 1
+  !
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  nfid = W_F(idf)%ncfid
+!-
+! 1.0 Create the time axes
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 1.0"
+!-
+! 1.1 Define the time dimensions needed for this file
+!-
+  iret = NF90_DEF_DIM (nfid,'time_counter', &
+ &                     NF90_UNLIMITED,W_F(idf)%tid)
+  DO iv=1,W_F(idf)%n_var
+    IF (W_F(idf)%W_V(iv)%l_bnd) THEN
+      iret = NF90_DEF_DIM (nfid,'tbnds',2,W_F(idf)%bid)
+      EXIT
+    ENDIF
+  ENDDO
+!-
+! 1.2 Define all the time axes needed for this file
+!-
+  DO itx=1,W_F(idf)%n_tax
+    dims(1) = W_F(idf)%tid
+    l_b = (INDEX(W_F(idf)%W_V(itx)%tax_name,"t_op_") == 1)
+    IF (itx > 1) THEN
+      str30 = W_F(idf)%W_V(itx)%tax_name
+    ELSE
+      str30 = "time_counter"
+    ENDIF
+    IF (l_b) THEN
+      str35 = TRIM(str30)//'_bnds'
+    ENDIF
+    iret = NF90_DEF_VAR (nfid,TRIM(str30),NF90_REAL8, &
+ &          dims(1),W_F(idf)%W_V(itx)%tdimid)
+    IF (itx <= 1) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid,'axis',"T")
+    ENDIF
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &          'standard_name',"time")
+!---
+!   To transform the current itau into a real date and take it
+!   as the origin of the file requires the time counter to change.
+!   Thus it is an operation the user has to ask for.
+!   This function should thus only be re-instated
+!   if there is a ioconf routine to control it.
+!---
+!-- rtime0 = itau2date(itau0(idf),date0(idf),deltat(idf))
+    rtime0 = W_F(idf)%date0
+!-
+    CALL ju2ymds(rtime0,year,month,day,sec)
+!---
+!   Catch any error induced by a change in calendar !
+!---
+    IF (year < 0) THEN
+      year = 2000+year
+    ENDIF
+!-
+    hours = INT(sec/(60.*60.))
+    minutes = INT((sec-hours*60.*60.)/60.)
+    sec = sec-(hours*60.*60.+minutes*60.)
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    'seconds since ',year,month,day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'units',TRIM(str70))
+!-
+    CALL ioget_calendar (str30)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'calendar',TRIM(str30))
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'title','Time')
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'long_name','Time axis')
+!-
+    WRITE (UNIT=str70, &
+ &   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
+ &    year,cal(month),day,hours,minutes,INT(sec)
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'time_origin',TRIM(str70))
+!---
+    IF (l_b) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &             'bounds',TRIM(str35))
+      dims(1:2) = (/ W_F(idf)%bid,W_F(idf)%tid /)
+      iret = NF90_DEF_VAR (nfid,TRIM(str35),NF90_REAL8, &
+ &            dims(1:2),W_F(idf)%W_V(itx)%tbndid)
+    ENDIF
+  ENDDO
+!-
+! 2.0 declare the variables
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 2.0"
+!-
+  DO iv=1,W_F(idf)%n_var
+!---
+    itax = W_F(idf)%W_V(iv)%t_axid
+!---
+    IF (W_F(idf)%regular) THEN
+      dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+      dim_cnt = 2
+    ELSE
+      dims(1) = W_F(idf)%xid
+      dim_cnt = 1
+    ENDIF
+!---
+    tmp_opp = W_F(idf)%W_V(iv)%topp
+    ziv = W_F(idf)%W_V(iv)%z_axid
+!---
+!   2.1 dimension of field
+!---
+    IF ((TRIM(tmp_opp) /= 'never')) THEN
+      IF (     (TRIM(tmp_opp) /= 'once')  &
+     &    .AND.(TRIM(tmp_opp) /= 'l_max') &
+     &    .AND.(TRIM(tmp_opp) /= 'l_min') ) THEN
+        IF (ziv == -99) THEN
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%tid,0 /)
+        ELSE
+          ndim = dim_cnt+2
+          dims(dim_cnt+1:dim_cnt+2) = &
+ &         (/ W_F(idf)%zax_ids(ziv),W_F(idf)%tid /)
+        ENDIF
+      ELSE
+        IF (ziv == -99) THEN
+          ndim = dim_cnt
+          dims(dim_cnt+1:dim_cnt+2) = (/ 0,0 /)
+        ELSE
+          ndim = dim_cnt+1
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%zax_ids(ziv),0 /)
+        ENDIF
+      ENDIF
+!-
+      iret = NF90_DEF_VAR (nfid,TRIM(W_F(idf)%W_V(iv)%v_name), &
+ &             W_F(idf)%W_V(iv)%v_typ,dims(1:ABS(ndim)),nvid)
+!-
+      IF( ndim == 4 ) THEN
+        IF( PRESENT( snc4chunks ) ) THEN
+          IF( snc4chunks%luse ) THEN
+           ichunksz = 1
+           iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%xid, len = ichunksz(1) )
+           iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%yid, len = ichunksz(2) )
+           IF ( ziv .NE. -99 ) &
+              iret = NF90_INQUIRE_DIMENSION( nfid, W_F(idf)%zax_ids(ziv), len = ichunksz(3) )
+           ichunksz(1) = MIN(ichunksz(1), MAX((ichunksz(1)-1)/snc4chunks%ni + 1,16))
+           ichunksz(2) = MIN(ichunksz(2), MAX((ichunksz(2)-1)/snc4chunks%nj + 1,16))
+           ichunksz(3) = MIN(ichunksz(3), MAX((ichunksz(3)-1)/snc4chunks%nk + 1, 1))
+           ! Always use a chunk size of 1 for the unlimited dimension
+           iret = SET_NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+           iret = SET_NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+          ENDIF
+        ENDIF
+      ENDIF
+      W_F(idf)%W_V(iv)%ncvid = nvid
+!-
+      IF (LEN_TRIM(W_F(idf)%W_V(iv)%unit_name) > 0) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'units', &
+ &                           TRIM(W_F(idf)%W_V(iv)%unit_name))
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'standard_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%std_name))
+!-
+      IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL8)
+      ELSE
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL4)
+      ENDIF
+      IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+        IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=8))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=8))
+        ELSE
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=4))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=4))
+        ENDIF
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'long_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%title))
+      iret = NF90_PUT_ATT (nfid,nvid,'online_operation', &
+ &                         TRIM(W_F(idf)%W_V(iv)%fullop))
+!-
+      SELECT CASE(ndim)
+      CASE(-3,2:4)
+      CASE DEFAULT
+        CALL ipslerr (3,"histend", &
+       &  'less than 2 or more than 4 dimensions are not', &
+       &  'allowed at this stage',' ')
+      END SELECT
+!-
+      assoc=TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,2)) &
+ &   //' '//TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,1))
+!-
+      ziv = W_F(idf)%W_V(iv)%z_axid
+      IF (ziv > 0) THEN
+        str30 = W_F(idf)%zax_name(ziv)
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+      ENDIF
+!-
+      IF (itax > 0) THEN
+        IF (itax > 1) THEN
+          str30 = W_F(idf)%W_V(itax)%tax_name
+        ELSE
+          str30 = "time_counter"
+        ENDIF
+        assoc = TRIM(str30)//' '//TRIM(assoc)
+!-
+        IF (l_dbg) THEN
+          WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", &
+ &          W_F(idf)%W_V(iv)%freq_opp,W_F(idf)%W_V(iv)%freq_wrt
+        ENDIF
+!-
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_operation', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_opp,KIND=4))
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_write', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_wrt,KIND=4))
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'coordinates',TRIM(assoc))
+    ENDIF
+  ENDDO
+!-
+! 2.2 Add DOMAIN attributes if needed
+!-
+  IF (W_F(idf)%dom_id_svg >= 0) THEN
+    CALL flio_dom_att (nfid,W_F(idf)%dom_id_svg)
+  ENDIF
+!-
+! 3.0 Put the netcdf file into write mode
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 3.0"
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+! 4.0 Give some informations to the user
+!-
+  IF (l_dbg) WRITE(*,*) "histend : 4.0"
+!-
+!!$  WRITE(str70,'("All variables have been initialized on file :",I3)') idf
+!!$  CALL ipslerr (1,'histend',str70,'',' ')
+!---------------------
+END SUBROUTINE histend
+!===
+SUBROUTINE histwrite_r1d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_1d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r1d
+!===
+SUBROUTINE histwrite_r2d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_2d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r2d
+!===
+SUBROUTINE histwrite_r3d (idf,pvarname,pitau,pdata,nbindex,nindex)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+!---------------------------------------------------------------------
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_3d=pdata)
+!---------------------------
+END SUBROUTINE histwrite_r3d
+!===
+SUBROUTINE histw_rnd (idf,pvarname,pitau,nbindex,nindex, &
+  &                   pdata_1d,pdata_2d,pdata_3d)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
+  INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL     :: pdata_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL   :: pdata_2d
+  REAL,DIMENSION(:,:,:),INTENT(IN),OPTIONAL :: pdata_3d
+!-
+  LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d
+  INTEGER :: iv,io,nbpt_out
+  INTEGER              :: nbpt_in1
+  INTEGER,DIMENSION(2) :: nbpt_in2
+  INTEGER,DIMENSION(3) :: nbpt_in3
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_1
+  CHARACTER(LEN=7) :: tmp_opp
+  CHARACTER(LEN=13) :: c_nam
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  l1d=PRESENT(pdata_1d); l2d=PRESENT(pdata_2d); l3d=PRESENT(pdata_3d);
+  IF      (l1d) THEN
+    c_nam = 'histwrite_r1d'
+  ELSE IF (l2d) THEN
+    c_nam = 'histwrite_r2d'
+  ELSE IF (l3d) THEN
+    c_nam = 'histwrite_r3d'
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite : ",c_nam
+  ENDIF
+!-
+! 1.0 Try to catch errors like specifying the wrong file ID.
+!     Thanks Marine for showing us what errors users can make !
+!-
+  IF ( (idf < 1).OR.(idf > nb_files_max) ) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'Illegal file ID in the histwrite of variable',pvarname,' ')
+  ENDIF
+!-
+! 1.1 Find the id of the variable to be written and the real time
+!-
+  CALL histvar_seq (idf,pvarname,iv)
+!-
+! 2.0 do nothing for never operation
+!-
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+  IF (TRIM(tmp_opp) == "never") THEN
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
+  ENDIF
+!-
+! 3.0 We check if we need to do an operation
+!-
+  IF (W_F(idf)%W_V(iv)%last_opp_chk == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable has already been analysed at the present', &
+ &    'time step',TRIM(pvarname))
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp_chk,do_oper)
+!-
+! 4.0 We check if we need to write the data
+!-
+  IF (W_F(idf)%W_V(iv)%last_wrt_chk == pitau) THEN
+    CALL ipslerr (3,"histwrite", &
+ &    'This variable as already been written for the present', &
+ &    'time step',' ')
+  ENDIF
+!-
+  CALL isittime &
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt_chk,do_write)
+!-
+! 5.0 histwrite called
+!-
+  IF (do_oper.OR.do_write) THEN
+!-
+!-- 5.1 Get the sizes of the data we will handle
+!-
+    IF (W_F(idf)%W_V(iv)%datasz_in(1) <= 0) THEN
+!---- There is the risk here that the user has over-sized the array.
+!---- But how can we catch this ?
+!---- In the worst case we will do impossible operations
+!---- on part of the data !
+      W_F(idf)%W_V(iv)%datasz_in(1:3) = -1
+      IF      (l1d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_1d)
+      ELSE IF (l2d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_2d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_2d,DIM=2)
+      ELSE IF (l3d) THEN
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_3d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_3d,DIM=2)
+        W_F(idf)%W_V(iv)%datasz_in(3) = SIZE(pdata_3d,DIM=3)
+      ENDIF
+    ENDIF
+!-
+!-- 5.2 The maximum size of the data will give the size of the buffer
+!-
+    IF (W_F(idf)%W_V(iv)%datasz_max <= 0) THEN
+      largebuf = .FALSE.
+      DO io=1,W_F(idf)%W_V(iv)%nbopp
+        IF (INDEX(fuchnbout,W_F(idf)%W_V(iv)%sopp(io)) > 0) THEN
+          largebuf = .TRUE.
+        ENDIF
+      ENDDO
+      IF (largebuf) THEN
+        W_F(idf)%W_V(iv)%datasz_max = &
+ &        W_F(idf)%W_V(iv)%scsize(1) &
+ &       *W_F(idf)%W_V(iv)%scsize(2) &
+ &       *W_F(idf)%W_V(iv)%scsize(3)
+      ELSE
+        IF      (l1d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1)
+        ELSE IF (l2d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2)
+        ELSE IF (l3d) THEN
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(3)
+        ENDIF
+      ENDIF
+    ENDIF
+!-
+    IF (.NOT.ALLOCATED(tbf_1)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
+      ENDIF
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_1)) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       c_nam//" : re-allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
+      ENDIF
+      DEALLOCATE(tbf_1)
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ENDIF
+!-
+!-- We have to do the first operation anyway.
+!-- Thus we do it here and change the ranke
+!-- of the data at the same time. This should speed up things.
+!-
+    nbpt_out = W_F(idf)%W_V(iv)%datasz_max
+    IF      (l1d) THEN
+      nbpt_in1 = W_F(idf)%W_V(iv)%datasz_in(1)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in1,pdata_1d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ELSE IF (l2d) THEN
+      nbpt_in2(1:2) = W_F(idf)%W_V(iv)%datasz_in(1:2)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in2,pdata_2d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ELSE IF (l3d) THEN
+      nbpt_in3(1:3) = W_F(idf)%W_V(iv)%datasz_in(1:3)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in3,pdata_3d, &
+ &                 missing_val,nbindex,nindex, &
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ENDIF
+    CALL histwrite_real (idf,iv,pitau,nbpt_out, &
+ &            tbf_1,nbindex,nindex,do_oper,do_write)
+  ENDIF
+!-
+! 6.0 Manage time steps
+!-
+  IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
+    W_F(idf)%W_V(iv)%last_opp_chk = pitau
+    W_F(idf)%W_V(iv)%last_wrt_chk = pitau
+  ELSE
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
+  ENDIF
+!-----------------------
+END SUBROUTINE histw_rnd
+!===
+SUBROUTINE histwrite_real &
+ & (idf,iv,pitau,nbdpt,tbf_1,nbindex,nindex,do_oper,do_write)
+!---------------------------------------------------------------------
+!- This subroutine is internal and does the calculations and writing
+!- if needed. At a later stage it should be split into an operation
+!- and writing subroutines.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pitau,iv, &
+ &                      nbindex,nindex(nbindex),nbdpt
+  REAL,DIMENSION(:)  :: tbf_1
+  LOGICAL,INTENT(IN) :: do_oper,do_write
+!-
+  INTEGER :: tsz,nfid,nvid,iret,itax,io,nbin,nbout
+  INTEGER :: nx,ny,nz,ky,kz,kt,kc
+  INTEGER,DIMENSION(4) :: corner,edges
+  INTEGER :: itime
+!-
+  REAL :: rtime
+  REAL,DIMENSION(2) :: t_bnd
+  CHARACTER(LEN=7) :: tmp_opp
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name
+    WRITE(*,*) "histwrite 0.0 : nbindex :",nbindex
+    WRITE(*,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...'
+  ENDIF
+!-
+! The sizes which can be encoutered
+!-
+  tsz =  W_F(idf)%W_V(iv)%zsize(1) &
+ &      *W_F(idf)%W_V(iv)%zsize(2) &
+ &      *W_F(idf)%W_V(iv)%zsize(3)
+!-
+! 1.0 We allocate and the temporary space needed for operations.
+!     The buffers are only deallocated when more space is needed.
+!     This reduces the umber of allocates but increases memory needs.
+!-
+  IF (.NOT.ALLOCATED(tbf_2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1)
+    ENDIF
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_2)) THEN
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite_real 1.2 re-allocate tbf_2 : ", &
+     & SIZE(tbf_1)," instead of ",SIZE(tbf_2)
+    ENDIF
+    DEALLOCATE(tbf_2)
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ENDIF
+!-
+  rtime = pitau*W_F(idf)%deltat
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+! 3.0 Do the operations or transfer the slab of data into tbf_1
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite: 3.0",idf
+  ENDIF
+!-
+! 3.1 DO the Operations only if needed
+!-
+  IF (do_oper) THEN
+    nbout = nbdpt
+!-
+!-- 3.4 We continue the sequence of operations
+!--     we started in the interface routine
+!-
+    DO io=2,W_F(idf)%W_V(iv)%nbopp,2
+      nbin = nbout
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io),nbin,tbf_1, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io), &
+ &      nbout,tbf_2)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &       "histwrite: 3.4a nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io)
+      ENDIF
+!-
+      nbin = nbout
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io+1),nbin,tbf_2, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io+1), &
+ &      nbout,tbf_1)
+      IF (l_dbg) THEN
+        WRITE(*,*) &
+ &     "histwrite: 3.4b nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io+1)
+      ENDIF
+    ENDDO
+!-
+!   3.5 Zoom into the data
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+ &     "histwrite: 3.5 size(tbf_1) : ",SIZE(tbf_1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in X :", &
+ &     W_F(idf)%W_V(iv)%zorig(1),W_F(idf)%W_V(iv)%zsize(1)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Y :", &
+ &     W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zsize(2)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab in Z :", &
+ &     W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zsize(3)
+      WRITE(*,*) &
+ &     "histwrite: 3.5 slab of input:", &
+ &     W_F(idf)%W_V(iv)%scsize(1), &
+ &     W_F(idf)%W_V(iv)%scsize(2), &
+ &     W_F(idf)%W_V(iv)%scsize(3)
+    ENDIF
+!---
+!-- We have to consider blocks of contiguous data
+!---
+    nx=MAX(W_F(idf)%W_V(iv)%zsize(1),1)
+    ny=MAX(W_F(idf)%W_V(iv)%zsize(2),1)
+    nz=MAX(W_F(idf)%W_V(iv)%zsize(3),1)
+    IF     (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1)) &
+ &          .AND.(W_F(idf)%W_V(iv)%zorig(2) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(2) &
+ &                == W_F(idf)%W_V(iv)%scsize(2))) THEN
+      kt = (W_F(idf)%W_V(iv)%zorig(3)-1)*nx*ny
+      tbf_2(1:nx*ny*nz) = tbf_1(kt+1:kt+nx*ny*nz)
+    ELSEIF (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1))) THEN
+      kc = -nx*ny
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        kc = kc+nx*ny
+        kt = ( (kz-1)*W_F(idf)%W_V(iv)%scsize(2) &
+ &            +W_F(idf)%W_V(iv)%zorig(2)-1)*nx
+        tbf_2(kc+1:kc+nx*ny) = tbf_1(kt+1:kt+nx*ny)
+      ENDDO
+    ELSE
+      kc = -nx
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        DO ky=W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zorig(2)+ny-1
+          kc = kc+nx
+          kt = ((kz-1)*W_F(idf)%W_V(iv)%scsize(2)+ky-1) &
+ &            *W_F(idf)%W_V(iv)%scsize(1) &
+ &            +W_F(idf)%W_V(iv)%zorig(1)-1
+          tbf_2(kc+1:kc+nx) = tbf_1(kt+1:kt+nx)
+        ENDDO
+      ENDDO
+    ENDIF
+!-
+!-- 4.0 Get the min and max of the field
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 4.0 tbf_1",idf,iv, &
+ &      TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1) = &
+ &      MIN(W_F(idf)%W_V(iv)%hist_minmax(1), &
+ &      MINVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+      W_F(idf)%W_V(iv)%hist_minmax(2) = &
+ &      MAX(W_F(idf)%W_V(iv)%hist_minmax(2), &
+ &      MAXVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+    ENDIF
+!-
+!-- 5.0 Do the operations if needed. In the case of instantaneous
+!--     output we do not transfer to the time_buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz
+    ENDIF
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, &
+ &           tbf_2,W_F(idf)%W_V(iv)%nb_opp)
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_opp = pitau
+    W_F(idf)%W_V(iv)%nb_opp = W_F(idf)%W_V(iv)%nb_opp+1
+!-
+  ENDIF
+!-
+! 6.0 Write to file if needed
+!-
+  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",idf
+!-
+  IF (do_write) THEN
+!-
+    nfid = W_F(idf)%ncfid
+    nvid = W_F(idf)%W_V(iv)%ncvid
+!-
+!-- 6.1 Do the operations that are needed before writting
+!-
+    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",idf
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      t_bnd(1:2) = (/ W_F(idf)%W_V(iv)%last_wrt*W_F(idf)%deltat,rtime /)
+      rtime = (t_bnd(1)+t_bnd(2))/2.0
+    ENDIF
+!-
+!-- 6.2 Add a value to the time axis of this variable if needed
+!-
+    IF (     (TRIM(tmp_opp) /= "l_max") &
+ &      .AND.(TRIM(tmp_opp) /= "l_min") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+!-
+      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",idf
+!-
+      itax  = W_F(idf)%W_V(iv)%t_axid
+      itime = W_F(idf)%W_V(iv)%nb_wrt+1
+!-
+      IF (W_F(idf)%W_V(itax)%tax_last < itime) THEN
+        iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tdimid, &
+ &               (/ rtime /),start=(/ itime /),count=(/ 1 /))
+        IF (W_F(idf)%W_V(itax)%tbndid > 0) THEN
+          iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tbndid, &
+ &                 t_bnd,start=(/ 1,itime /),count=(/ 2,1 /))
+        ENDIF
+        W_F(idf)%W_V(itax)%tax_last = itime
+      ENDIF
+    ELSE
+      itime=1
+    ENDIF
+!-
+!-- 6.3 Write the data. Only in the case of instantaneous output
+!       we do not write the buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%scsize(3) == 1) THEN
+      IF (W_F(idf)%regular) THEN
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2),1,0 /)
+      ELSE
+        corner(1:4) = (/ 1,itime,0,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1),1,0,0 /)
+      ENDIF
+    ELSE
+      IF (W_F(idf)%regular) THEN
+        corner(1:4) = (/ 1,1,1,itime /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1 /)
+      ELSE
+        corner(1:4) = (/ 1,1,itime,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1,0 /)
+      ENDIF
+    ENDIF
+!-
+    IF (     (TRIM(tmp_opp) /= "inst") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      iret = NF90_PUT_VAR (nfid,nvid,W_F(idf)%W_V(iv)%t_bf, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ELSE
+      iret = NF90_PUT_VAR (nfid,nvid,tbf_2, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_wrt = pitau
+    W_F(idf)%W_V(iv)%nb_wrt = W_F(idf)%W_V(iv)%nb_wrt+1
+    W_F(idf)%W_V(iv)%nb_opp = 0
+!---
+!   After the write the file can be synchronized so that no data is
+!   lost in case of a crash. This feature gives up on the benefits of
+!   buffering and should only be used in debuging mode. A flag is
+!   needed here to switch to this mode.
+!---
+!   iret = NF90_SYNC (nfid)
+!-
+  ENDIF
+!----------------------------
+END SUBROUTINE histwrite_real
+!===
+SUBROUTINE histvar_seq (idf,pvarname,idv)
+!---------------------------------------------------------------------
+!- This subroutine optimize the search for the variable in the table.
+!- In a first phase it will learn the succession of the variables
+!- called and then it will use the table to guess what comes next.
+!- It is the best solution to avoid lengthy searches through array
+!- vectors.
+!-
+!- ARGUMENTS :
+!-
+!- idf      : id of the file on which we work
+!- pvarname : The name of the variable we are looking for
+!- idv      : The var id we found
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in)  :: idf
+  CHARACTER(LEN=*),INTENT(IN) :: pvarname
+  INTEGER,INTENT(out) :: idv
+!-
+  LOGICAL,SAVE :: learning(nb_files_max)=.TRUE.
+  INTEGER,SAVE :: overlap(nb_files_max) = -1
+  INTEGER,SAVE :: varseq(nb_files_max,nb_var_max*3)
+  INTEGER,SAVE :: varseq_len(nb_files_max) = 0
+  INTEGER,SAVE :: varseq_pos(nb_files_max)
+  INTEGER,SAVE :: varseq_err(nb_files_max) = 0
+  INTEGER      :: ib,sp,nn,pos
+  CHARACTER(LEN=70) :: str70
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(idf)
+  ENDIF
+!-
+  IF (learning(idf)) THEN
+!-
+!-- 1.0 We compute the length over which we are going
+!--     to check the overlap
+!-
+    IF (overlap(idf) <= 0) THEN
+      IF (W_F(idf)%n_var > 6) THEN
+        overlap(idf) = W_F(idf)%n_var/3*2
+      ELSE
+        overlap(idf) = W_F(idf)%n_var
+      ENDIF
+    ENDIF
+!-
+!-- 1.1 Find the position of this string
+!-
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
+    IF (pos > 0) THEN
+      idv = pos
+    ELSE
+      CALL ipslerr (3,"histvar_seq", &
+ &      'The name of the variable you gave has not been declared', &
+ &      'You should use subroutine histdef for declaring variable', &
+ &      TRIM(pvarname))
+    ENDIF
+!-
+!-- 1.2 If we have not given up we store the position
+!--     in the sequence of calls
+!-
+    IF (varseq_err(idf) >= 0) THEN
+      sp = varseq_len(idf)+1
+      IF (sp <= nb_var_max*3) THEN
+        varseq(idf,sp) = idv
+        varseq_len(idf) = sp
+      ELSE
+        CALL ipslerr (2,"histvar_seq",&
+ &       'The learning process has failed and we give up. '// &
+ &       'Either you sequence is',&
+ &       'too complex or I am too dumb. '// &
+ &       'This will only affect the efficiency',&
+ &       'of your code. Thus if you wish to save time'// &
+ &       ' contact the IOIPSL team. ')
+        WRITE(*,*) 'The sequence we have found up to now :'
+        WRITE(*,*) varseq(idf,1:sp-1)
+        varseq_err(idf) = -1
+      ENDIF
+!-
+!---- 1.3 Check if we have found the right overlap
+!-
+      IF (varseq_len(idf) >= overlap(idf)*2) THEN
+!-
+!------ We skip a few variables if needed as they could come
+!------ from the initialisation of the model.
+!-
+        DO ib = 0,sp-overlap(idf)*2
+          IF ( learning(idf) .AND.&
+            & SUM(ABS(varseq(idf,ib+1:ib+overlap(idf)) -&
+            & varseq(idf,sp-overlap(idf)+1:sp))) == 0 ) THEN
+            learning(idf) = .FALSE.
+            varseq_len(idf) = sp-overlap(idf)-ib
+            varseq_pos(idf) = overlap(idf)+ib
+            varseq(idf,1:varseq_len(idf)) = &
+ &            varseq(idf,ib+1:ib+varseq_len(idf))
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDIF
+  ELSE
+!-
+!-- 2.0 Now we know how the calls to histwrite are sequenced
+!--     and we can get a guess at the var ID
+!-
+    nn = varseq_pos(idf)+1
+    IF (nn > varseq_len(idf)) nn = 1
+!-
+    idv = varseq(idf,nn)
+!-
+    IF (TRIM(W_F(idf)%W_V(idv)%v_name) /= TRIM(pvarname)) THEN
+      CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
+      IF (pos > 0) THEN
+        idv = pos
+      ELSE
+        CALL ipslerr (3,"histvar_seq", &
+ &  'The name of the variable you gave has not been declared',&
+ &  'You should use subroutine histdef for declaring variable', &
+ &  TRIM(pvarname))
+      ENDIF
+      varseq_err(idf) = varseq_err(idf)+1
+    ELSE
+!-
+!---- We only keep the new position if we have found the variable
+!---- this way. This way an out of sequence call to histwrite does
+!---- not defeat the process.
+!-
+      varseq_pos(idf) = nn
+    ENDIF
+!-
+!!$    IF (varseq_err(idf) >= 10) THEN
+!!$      WRITE(str70,'("for file ",I3)') idf
+!!$      CALL ipslerr (2,"histvar_seq", &
+!!$ &  'There were 10 errors in the learned sequence of variables',&
+!!$ &  str70,'This looks like a bug, please report it.')
+!!$         varseq_err(idf) = 0
+!!$    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv
+  ENDIF
+!-------------------------
+END SUBROUTINE histvar_seq
+!===
+SUBROUTINE histsync (idf)
+!---------------------------------------------------------------------
+!- This subroutine will synchronise all
+!- (or one if defined) opened files.
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,iret,i_s,i_e
+!-
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histsync"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histsync', &
+ &       'Unable to synchronise the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histsync','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histsync - synchronising file number ',ifile
+      ENDIF
+      iret = NF90_SYNC(W_F(ifile)%ncfid)
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histsync"
+  ENDIF
+!----------------------
+END SUBROUTINE histsync
+!===
+SUBROUTINE histclo (idf)
+!---------------------------------------------------------------------
+!- This subroutine will close all (or one if defined) opened files
+!-
+!- VERSION
+!-
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,nfid,nvid,iret,iv,i_s,i_e
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histclo"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histclo', &
+ &       'Unable to close the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histclo','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histclo - closing specified file number :',ifile
+      ENDIF
+      nfid = W_F(ifile)%ncfid
+      iret = NF90_REDEF(nfid)
+!-----
+!---- 1. Loop on the number of variables to add some final information
+!-----
+      IF (l_dbg) THEN
+        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var
+      ENDIF
+      DO iv=1,W_F(ifile)%n_var
+!------ Extrema
+        IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN
+          IF (l_dbg) THEN
+            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1)
+            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2)
+          ENDIF
+          IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN
+!---------- Put the min and max values on the file
+            nvid = W_F(ifile)%W_V(iv)%ncvid
+            IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8))
+            ELSE
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4))
+            ENDIF
+          ENDIF
+        ENDIF
+!------ Time-Buffers
+        IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN
+          DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf)
+        ENDIF
+!------ Reinitialize the sizes
+        W_F(ifile)%W_V(iv)%datasz_in(:) = -1
+        W_F(ifile)%W_V(iv)%datasz_max = -1
+      ENDDO
+!-----
+!---- 2. Close the file
+!-----
+      IF (l_dbg) WRITE(*,*) '  close file :',nfid
+      iret = NF90_CLOSE(nfid)
+      W_F(ifile)%ncfid = -1
+      W_F(ifile)%dom_id_svg = -1
+    ENDIF
+  ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histclo"
+  ENDIF
+!---------------------
+END SUBROUTINE histclo
+!===
+SUBROUTINE ioconf_modname (str)
+!---------------------------------------------------------------------
+!- This subroutine allows to configure the name
+!- of the model written into the file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: str
+!---------------------------------------------------------------------
+  IF (.NOT.lock_modname) THEN
+    model_name = str(1:MIN(LEN_TRIM(str),80))
+    lock_modname = .TRUE.
+  ELSE
+    CALL ipslerr (2,"ioconf_modname", &
+   &  'The model name can only be changed once and only', &
+   &  'before it is used. It is now set to :',model_name)
+  ENDIF
+!----------------------------
+END SUBROUTINE ioconf_modname
+!-
+!===
+!-
+!-----------------
+END MODULE histcom
Index: vendors/IOIPSL/src/ioipsl.f90
===================================================================
--- vendors/IOIPSL/src/ioipsl.f90	(revision 9621)
+++ vendors/IOIPSL/src/ioipsl.f90	(revision 9621)
@@ -0,0 +1,17 @@
+MODULE ioipsl
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!
+  USE errioipsl 
+  USE stringop
+  USE mathelp    
+  USE getincom
+  USE calendar   
+  USE fliocom    
+  USE flincom    
+  USE histcom    
+  USE restcom
+END MODULE ioipsl
Index: vendors/IOIPSL/src/mathelp.f90
===================================================================
--- vendors/IOIPSL/src/mathelp.f90	(revision 9621)
+++ vendors/IOIPSL/src/mathelp.f90	(revision 9621)
@@ -0,0 +1,3122 @@
+MODULE mathelp
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+  USE errioipsl,ONLY : ipslerr
+  USE stringop
+!-
+  PRIVATE
+  PUBLIC :: mathop,moycum,buildop
+!-
+  INTERFACE mathop
+    MODULE PROCEDURE mathop_r11,mathop_r21,mathop_r31
+  END INTERFACE
+!-
+!- Variables used to detect and identify the operations
+!-
+  CHARACTER(LEN=80),SAVE :: &
+ &  seps='( ) , + - / * ^', ops = '+ - * / ^', mima = 'min max'
+  CHARACTER(LEN=250),SAVE :: &
+ &  funcs = 'sin cos tan asin acos atan exp log sqrt chs abs '&
+ & //'cels kelv deg rad gather scatter fill coll undef only ident'
+  CHARACTER(LEN=120),SAVE :: &
+ &  indexfu = 'gather, scatter, fill, coll, undef, only'
+!---------------------------------------------------------------------
+CONTAINS
+!===
+SUBROUTINE buildop (c_str,ex_topps,topp,fill_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+!- This subroutine decomposes the input string in the elementary
+!- functions which need to be applied to the vector of data.
+!- This vector is represented by X in the string.
+!- This subroutine is the driver of the decomposition and gets
+!- the time operation but then call decoop for the other operations
+!-
+!- INPUT
+!-
+!- c_str    : String containing the operations
+!- ex_toops : Time operations that can be expected within the string
+!- fill_val :
+!-
+!- OUTPUT
+!-
+!- topp   : Time operation
+!- opps   :
+!- scal   :
+!- nbops  :
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: c_str,ex_topps
+  CHARACTER(LEN=*),INTENT(OUT) :: topp
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
+  REAL,INTENT(IN) :: fill_val
+  REAL,DIMENSION(:),INTENT(OUT) :: scal
+  INTEGER,INTENT(OUT) :: nbops
+!-
+  CHARACTER(LEN=LEN(c_str)) :: str,new_str
+  INTEGER :: leng,ind_opb,ind_clb
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning'
+!-
+  str = c_str
+  leng = LEN_TRIM(str)
+  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
+    str = str(2:leng-1)
+    leng = leng-2
+  ENDIF
+!-
+  IF (check) &
+ &  WRITE(*,*) 'buildop : Starting to test the various options'
+!-
+  IF (leng <= 5 .AND. INDEX(ex_topps,str(1:leng)) > 0) THEN
+    IF (check) WRITE(*,*) 'buildop : Time operation only'
+    nbops = 0
+    topp = str(1:leng)
+  ELSE
+    IF (check) THEN
+      WRITE(*,*) 'buildop : Time operation and something else'
+    ENDIF
+!--
+    ind_opb = INDEX(str(1:leng),'(')
+    IF (ind_opb > 0) THEN
+      IF (INDEX(ex_topps,str(1:ind_opb-1)) > 0) THEN
+        IF (check) THEN
+          WRITE(*,'(2a)') &
+ &          ' buildop : Extract time operation from : ',str
+        ENDIF
+        topp = str(1:ind_opb-1)
+        ind_clb = INDEX(str(1:leng),')',BACK=.TRUE.)
+        new_str = str(ind_opb+1:ind_clb-1)
+        IF (check) THEN
+          WRITE(*,'(2a,2I3)') &
+ &          ' buildop : Call decoop ',new_str,ind_opb,ind_clb
+        ENDIF
+        CALL decoop (new_str,fill_val,opps,scal,nbops)
+      ELSE
+        CALL ipslerr(3,'buildop', &
+ &        'time operation does not exist',str(1:ind_opb-1),' ')
+      ENDIF
+    ELSE
+      CALL ipslerr(3,'buildop', &
+ &      'some long operation exists but wihout parenthesis', &
+ &      str(1:leng),' ')
+    ENDIF
+  ENDIF
+!-
+  IF (check) THEN
+    DO leng=1,nbops
+      WRITE(*,*) &
+ &      'buildop : i -- opps, scal : ',leng,opps(leng),scal(leng)
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE buildop
+!===
+SUBROUTINE decoop (pstr,fill_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: pstr
+  REAL,INTENT(IN) :: fill_val
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
+  REAL,DIMENSION(:),INTENT(OUT) :: scal
+  INTEGER,INTENT(OUT) :: nbops
+!-
+  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
+  INTEGER,DIMENSION(2) :: f_pos,s_pos
+  CHARACTER(LEN=20) :: opp_str,scal_str
+  CHARACTER(LEN=LEN(pstr)) :: str
+  INTEGER :: nbsep,nbops_max,xpos,leng,ppos,epos,int_tmp
+  CHARACTER(LEN=3) :: tl,dl
+  CHARACTER(LEN=10) :: fmt
+!-
+  LOGICAL :: check = .FALSE.,prio
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,'(2A)') ' decoop : Incoming string : ',pstr
+!-
+  str = pstr; nbops = 0;
+!-
+  CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
+  IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep
+!-
+  nbops_max = min(SIZE(opps),SIZE(scal))
+!-
+  DO WHILE (nbsep > 0)
+    IF (nbops >= nbops_max) THEN
+      CALL ipslerr(3,'decoop','Expression too complex',TRIM(str),' ')
+    ENDIF
+!--
+    xpos = INDEX(str,'X')
+    leng = LEN_TRIM(str)
+    nbops = nbops+1
+!--
+    IF (check) THEN
+      WRITE(*,*) 'decoop : str   -> ',TRIM(str)
+      WRITE(*,*) 'decoop : nbops -> ',nbops
+      WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2)
+      WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2)
+    ENDIF
+!---
+!-- Start the analysis of the syntax. 3 types of constructs
+!-- are recognized.  They are scanned sequentialy
+!---
+    IF (nbsep == 1) THEN
+      IF (check) WRITE(*,*) 'decoop : Only one operation'
+      IF (INDEX(ops,f_char(1)) > 0) THEN
+!------ Type : scal+X
+        IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
+          opp_str = f_char(1)//'I'
+        ELSE
+          opp_str = f_char(1)
+        ENDIF
+        scal_str = str(s_pos(1)+1:f_pos(1)-1)
+        str = 'X'
+      ELSE IF (INDEX(ops,f_char(2)) > 0) THEN
+!------ Type : X+scal
+        opp_str = f_char(2)
+        scal_str = str(f_pos(2)+1:s_pos(2)-1)
+        str = 'X'
+      ELSE
+        CALL ipslerr(3,'decoop', &
+ &        'Unknown operations of type X+scal',f_char(1),pstr)
+      ENDIF
+    ELSE
+      IF (check) WRITE(*,*) 'decoop : More complex operation'
+      IF ( f_char(1) == '(' .AND. f_char(2) == ')' ) THEN
+!------ Type : sin(X)
+        opp_str = str(s_pos(1)+1:f_pos(1)-1)
+        scal_str = '?'
+        str = str(1:s_pos(1))//'X'//str(f_pos(2)+1:leng)
+      ELSE IF (    (f_char(1) == '(' .AND. f_char(2) == ',')&
+ &             .OR.(f_char(1) == ',' .AND. f_char(2) == ')')) THEN
+!------ Type : max(X,scal) or max(scal,X)
+        IF (f_char(1) == '(' .AND. s_char(2) == ')') THEN
+!-------- Type : max(X,scal)
+          opp_str = str(f_pos(1)-3:f_pos(1)-1)
+          scal_str = str(f_pos(2)+1:s_pos(2)-1)
+          str = str(1:f_pos(1)-4)//'X'//str(s_pos(2)+1:leng)
+        ELSE IF (f_char(1) == ',' .AND. s_char(1) == '(') THEN
+!-------- Type : max(scal,X)
+          opp_str = str(s_pos(1)-3:s_pos(1)-1)
+          scal_str = str(s_pos(1)+1:f_pos(1)-1)
+          str = str(1:s_pos(1)-4)//'X'//str(f_pos(2)+1:leng)
+        ELSE
+          CALL ipslerr(3,'decoop','Syntax error 1',str,' ')
+        ENDIF
+      ELSE
+        prio = (f_char(2) == '*').OR.(f_char(2) == '^')
+        IF (     (INDEX(ops,f_char(1)) > 0) &
+ &          .AND.(xpos-f_pos(1) == 1).AND.(.NOT.prio) ) THEN
+!-------- Type : ... scal+X ...
+          IF (f_char(1) == '-' .OR. f_char(1) == '/') THEN
+            opp_str = f_char(1)//'I'
+          ELSE
+            opp_str = f_char(1)
+          ENDIF
+          scal_str = str(s_pos(1)+1:f_pos(1)-1)
+          str = str(1:s_pos(1))//'X'//str(f_pos(1)+2:leng)
+        ELSE IF (     (INDEX(ops,f_char(2)) > 0) &
+ &               .AND.(f_pos(2)-xpos == 1) ) THEN
+!-------- Type : ... X+scal ...
+          opp_str = f_char(2)
+          scal_str = str(f_pos(2)+1:s_pos(2)-1)
+          str = str(1:f_pos(2)-2)//'X'//str(s_pos(2):leng)
+        ELSE
+          CALL ipslerr(3,'decoop','Syntax error 2',str,' ')
+        ENDIF
+      ENDIF
+    ENDIF
+!---
+    IF (check) WRITE(*,*) 'decoop : Finished syntax,str = ',TRIM(str)
+!---
+!-- Now that the different components of the operation are identified
+!-- we transform them into what is going to be used in the program
+!---
+    IF (INDEX(scal_str,'?') > 0) THEN
+      IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN
+        opps(nbops) = opp_str(1:LEN_TRIM(opp_str))
+        scal(nbops) = fill_val
+      ELSE
+        CALL ipslerr(3,'decoop', &
+ &        'Unknown function',opp_str(1:LEN_TRIM(opp_str)),' ')
+      ENDIF
+    ELSE
+      leng = LEN_TRIM(opp_str)
+      IF (INDEX(mima,opp_str(1:leng)) > 0) THEN
+        opps(nbops) = 'fu'//opp_str(1:leng)
+      ELSE
+        IF (INDEX(opp_str(1:leng),'+') > 0) THEN
+          opps(nbops) = 'add'
+        ELSE IF (INDEX(opp_str(1:leng),'-I') > 0) THEN
+          opps(nbops) = 'subi'
+        ELSE IF (INDEX(opp_str(1:leng),'-') > 0) THEN
+          opps(nbops) = 'sub'
+        ELSE IF (INDEX(opp_str(1:leng),'*') > 0) THEN
+          opps(nbops) = 'mult'
+        ELSE IF (INDEX(opp_str(1:leng),'/') > 0) THEN
+          opps(nbops) = 'div'
+        ELSE IF (INDEX(opp_str(1:leng),'/I') > 0) THEN
+          opps(nbops) = 'divi'
+        ELSE IF (INDEX(opp_str(1:leng),'^') > 0) THEN
+          opps(nbops) = 'power'
+        ELSE
+          CALL ipslerr(3,'decoop', &
+ &          'Unknown operation',opp_str(1:leng),' ')
+        ENDIF
+      ENDIF
+!-----
+      leng = LEN_TRIM(scal_str)
+      ppos = INDEX(scal_str,'.')
+      epos = INDEX(scal_str,'e')
+      IF (epos == 0) epos = INDEX(scal_str,'E')
+!-----
+!---- Try to catch a few errors
+!-----
+      IF (INDEX(ops,scal_str) > 0) THEN
+        CALL ipslerr(3,'decoop', &
+ &        'Strange scalar you have here ',scal_str,pstr)
+      ENDIF
+      IF (epos > 0) THEN
+        WRITE(tl,'(I3.3)') leng
+        WRITE(dl,'(I3.3)') epos-ppos-1
+        fmt='(e'//tl//'.'//dl//')'
+        READ(scal_str,fmt) scal(nbops)
+      ELSE IF (ppos > 0) THEN
+        WRITE(tl,'(I3.3)') leng
+        WRITE(dl,'(I3.3)') leng-ppos
+        fmt='(f'//tl//'.'//dl//')'
+        READ(scal_str,fmt) scal(nbops)
+      ELSE
+        WRITE(tl,'(I3.3)') leng
+        fmt = '(I'//tl//')'
+        READ(scal_str,fmt) int_tmp
+        scal(nbops) = REAL(int_tmp)
+      ENDIF
+    ENDIF
+    IF (check) WRITE(*,*) 'decoop : Finished interpretation'
+    CALL findsep(str,nbsep,f_char,f_pos,s_char,s_pos)
+  ENDDO
+!--------------------
+END SUBROUTINE decoop
+!===
+SUBROUTINE findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
+!---------------------------------------------------------------------
+!- Subroutine finds all separators in a given string
+!- It returns the following information about str :
+!-   f_char : The first separation character
+!-            (1 for before and 2 for after)
+!-   f_pos  : The position of the first separator
+!-   s_char : The second separation character
+!-            (1 for before and 2 for after)
+!-   s_pos  : The position of the second separator
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(INOUT) :: str
+  INTEGER :: nbsep
+  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
+  INTEGER,DIMENSION(2) :: f_pos,s_pos
+!-
+  CHARACTER(LEN=10) :: str_tmp
+  LOGICAL :: f_found,s_found
+  INTEGER :: ind,xpos,leng,i
+!-
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  IF (check) WRITE(*,*) 'findsep : call cleanstr: ',TRIM(str)
+!-
+  CALL cleanstr(str)
+!-
+  IF (check) WRITE(*,*) 'findsep : out of cleanstr: ',TRIM(str)
+!-
+  xpos = INDEX(str,'X')
+  leng = LEN_TRIM(str)
+!-
+  f_pos(1:2) = (/ 0,leng+1 /)
+  f_char(1:2) = (/ '?','?' /)
+  s_pos(1:2) = (/ 0,leng+1 /)
+  s_char(1:2) = (/ '?','?' /)
+!-
+  nbsep = 0
+!-
+  f_found = .FALSE.
+  s_found = .FALSE.
+  IF (xpos > 1) THEN
+    DO i=xpos-1,1,-1
+      ind = INDEX(seps,str(i:i))
+      IF (ind > 0) THEN
+        IF (.NOT.f_found) THEN
+          f_char(1) = str(i:i)
+          f_pos(1) = i
+          nbsep = nbsep+1
+          f_found = .TRUE.
+        ELSE IF (.NOT.s_found) THEN
+          s_char(1) = str(i:i)
+          s_pos(1) = i
+          nbsep = nbsep+1
+          s_found = .TRUE.
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  f_found = .FALSE.
+  s_found = .FALSE.
+  IF (xpos < leng) THEN
+    DO i=xpos+1,leng
+      ind = INDEX(seps,str(i:i))
+      IF (ind > 0) THEN
+        IF (.NOT.f_found) THEN
+          f_char(2) = str(i:i)
+          f_pos(2) = i
+          nbsep = nbsep+1
+          f_found = .TRUE.
+        ELSE IF (.NOT.s_found) THEN
+          s_char(2) = str(i:i)
+          s_pos(2) = i
+          nbsep = nbsep+1
+          s_found = .TRUE.
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF (nbsep > 4) THEN
+    WRITE(str_tmp,'("number :",I3)') nbsep
+    CALL ipslerr(3,'findsep', &
+ &    'How can I find that many separators',str_tmp,TRIM(str))
+  ENDIF
+!-
+  IF (check) WRITE(*,*) 'Finished findsep : ',nbsep,leng
+!---------------------
+END SUBROUTINE findsep
+!===
+SUBROUTINE cleanstr(str)
+!---------------------------------------------------------------------
+!- We clean up the string by taking out the extra () and puting
+!- everything in lower case except for the X describing the variable
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(INOUT) :: str
+!-
+  INTEGER :: ind,leng,ic,it
+  LOGICAL :: check = .FALSE.
+!---------------------------------------------------------------------
+  leng = LEN_TRIM(str)
+  CALL strlowercase(str)
+!-
+  ind = INDEX(str,'x')
+  IF (check) THEN
+    WRITE (*,*) 'cleanstr 1.0 : ind = ',ind, &
+&               ' str = ',str(1:leng),'---'
+  ENDIF
+!-
+! If the character before the x is not a letter then we can assume
+! that it is the variable and promote it to a capital letter
+!-
+  DO WHILE (ind > 0)
+    ic = 0
+    IF (ind > 1) ic = IACHAR(str(ind-1:ind-1))
+    IF (ic < 97 .OR. ic > 122) THEN
+      str(ind:ind) = 'X'
+    ENDIF
+    it = INDEX(str(ind+1:leng),'x')
+    IF (it > 0) THEN
+      ind = ind+it
+    ELSE
+      ind = it
+    ENDIF
+  ENDDO
+!-
+  IF (check) WRITE (*,*) 'cleanstr 2.0 : str = ',str(1:leng),'---'
+!-
+  IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
+    str = str(2:leng-1)
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 3.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str,'((X))')
+  IF (ind > 0) THEN
+    str=str(1:ind-1)//'(X)'//str(ind+5:leng)//'  '
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 4.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str,'(X)')
+  IF (ind > 0 .AND. ind+3 < leng) THEN
+    IF (      (INDEX(seps,str(ind-1:ind-1)) > 0) &
+ &      .AND. (INDEX(seps,str(ind+3:ind+3)) > 0) ) THEN
+      str=str(1:ind-1)//'X'//str(ind+3:leng)//'  '
+    ENDIF
+  ENDIF
+!-
+  IF (check) WRITE (*,*) 'cleanstr 5.0 : str = ',str(1:leng),'---'
+!-
+  leng = LEN_TRIM(str)
+  ind = INDEX(str(1:leng),' ')
+  DO WHILE (ind > 0)
+    str=str(1:ind-1)//str(ind+1:leng)//' '
+    leng = LEN_TRIM(str)
+    ind = INDEX(str(1:leng),' ')
+  ENDDO
+!-
+  IF (check) WRITE (*,*) 'cleanstr 6.0 : str = ',str(1:leng),'---'
+!----------------------
+END SUBROUTINE cleanstr
+!===
+!===
+SUBROUTINE mathop_r11 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operation
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb,nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r11(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r11(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r11(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r11(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r11(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r11(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r11(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r11(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r11(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r11(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r11(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r11(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r11(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r11(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r11(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r11(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > nb) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r11(nb,work_in,nb_index,nindex, &
+&                              miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r11(nb,work_in,nb_index,nindex, &
+&                            miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing',&
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r11", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r11(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r11(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r11
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = SIN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_sin_r11 = 0
+!----------------------
+END FUNCTION ma_sin_r11
+!===
+INTEGER FUNCTION ma_cos_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = COS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_cos_r11 = 0
+!----------------------
+END FUNCTION ma_cos_r11
+!===
+INTEGER FUNCTION ma_tan_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = TAN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_tan_r11 = 0
+!----------------------
+END FUNCTION ma_tan_r11
+!===
+INTEGER FUNCTION ma_asin_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ASIN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_asin_r11 = 0
+!-----------------------
+END FUNCTION ma_asin_r11
+!===
+INTEGER FUNCTION ma_acos_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ACOS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_acos_r11 = 0
+!-----------------------
+END FUNCTION ma_acos_r11
+!===
+INTEGER FUNCTION ma_atan_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ATAN(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_atan_r11 = 0
+!-----------------------
+END FUNCTION ma_atan_r11
+!===
+INTEGER FUNCTION ma_exp_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = EXP(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_exp_r11 = 0
+!----------------------
+END FUNCTION ma_exp_r11
+!===
+INTEGER FUNCTION ma_log_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = log(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_log_r11 = 0
+!----------------------
+END FUNCTION ma_log_r11
+!===
+INTEGER FUNCTION ma_sqrt_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = SQRT(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_sqrt_r11 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r11
+!===
+INTEGER FUNCTION ma_abs_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = ABS(x(i))
+  ENDDO
+!-
+  nbo = nb
+  ma_abs_r11 = 0
+!----------------------
+END FUNCTION ma_abs_r11
+!===
+INTEGER FUNCTION ma_chs_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*(-1.)
+  ENDDO
+!-
+  nbo = nb
+  ma_chs_r11 = 0
+!----------------------
+END FUNCTION ma_chs_r11
+!===
+INTEGER FUNCTION ma_cels_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)-273.15
+  ENDDO
+!-
+  nbo = nb
+  ma_cels_r11 = 0
+!-----------------------
+END FUNCTION ma_cels_r11
+!===
+INTEGER FUNCTION ma_kelv_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)+273.15
+  ENDDO
+!-
+  nbo = nb
+  ma_kelv_r11 = 0
+!-----------------------
+END FUNCTION ma_kelv_r11
+!===
+INTEGER FUNCTION ma_deg_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*57.29577951
+  ENDDO
+!-
+  nbo = nb
+  ma_deg_r11 = 0
+!-----------------------
+END FUNCTION ma_deg_r11
+!===
+INTEGER FUNCTION ma_rad_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*0.01745329252
+  ENDDO
+!-
+  nbo = nb
+  ma_rad_r11 = 0
+!----------------------
+END FUNCTION ma_rad_r11
+!===
+INTEGER FUNCTION ma_ident_r11(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,i
+  REAL :: x(nb),y(nbo)
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_ident_r11 = 0
+!------------------------
+END FUNCTION ma_ident_r11
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)+s
+  ENDDO
+!-
+  nbo = nb
+  ma_add_r11 = 0
+!-----------------------
+  END FUNCTION ma_add_r11
+!===
+INTEGER FUNCTION ma_sub_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)-s
+  ENDDO
+!-
+  nbo = nb
+  ma_sub_r11 = 0
+!----------------------
+END FUNCTION ma_sub_r11
+!===
+INTEGER FUNCTION ma_subi_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) =  s-x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_subi_r11 = 0
+!-----------------------
+END FUNCTION ma_subi_r11
+!===
+INTEGER FUNCTION ma_mult_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)*s
+  ENDDO
+!-
+  nbo = nb
+  ma_mult_r11 = 0
+!-----------------------
+END FUNCTION ma_mult_r11
+!===
+INTEGER FUNCTION ma_div_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)/s
+  ENDDO
+!-
+  nbo = nb
+  ma_div_r11 = 0
+!-----------------------
+  END FUNCTION ma_div_r11
+!===
+INTEGER FUNCTION ma_divi_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = s/x(i)
+  ENDDO
+!-
+  nbo = nb
+  ma_divi_r11 = 0
+!-----------------------
+END FUNCTION ma_divi_r11
+!===
+INTEGER FUNCTION ma_power_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = x(i)**s
+  ENDDO
+!-
+  nbo = nb
+  ma_power_r11 = 0
+!-----------------------
+END FUNCTION ma_power_r11
+!===
+INTEGER FUNCTION ma_fumin_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = MIN(x(i),s)
+  ENDDO
+!-
+  nbo = nb
+  ma_fumin_r11 = 0
+!------------------------
+END FUNCTION ma_fumin_r11
+!===
+INTEGER FUNCTION ma_fumax_r11(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo
+  REAL :: x(nb),s,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,nb
+    y(i) = MAX(x(i),s)
+  ENDDO
+!-
+  nbo = nb
+  ma_fumax_r11 = 0
+!------------------------
+END FUNCTION ma_fumax_r11
+!===
+INTEGER FUNCTION ma_fuscat_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ii,ipos
+!---------------------------------------------------------------------
+  ma_fuscat_r11 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb) THEN
+    ipos = 0
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        ipos = ipos+1
+        y(ind(i)) = x(ipos)
+      ELSE
+        IF (ind(i) > nbo) ma_fuscat_r11  = ma_fuscat_r11+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r11  = ma_fuscat_r11+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r11  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r11
+!===
+INTEGER FUNCTION ma_fugath_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r11 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    DO i=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(i) > 0) THEN
+          ipos = ipos+1
+          y(ipos) = x(ind(i))
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r11  = ma_fugath_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r11 = 1
+  ENDIF
+!-
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r11
+!===
+INTEGER FUNCTION ma_fufill_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ii,ipos
+!---------------------------------------------------------------------
+  ma_fufill_r11 = 0
+!-
+  IF (nbi <= nb) THEN
+    ipos = 0
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        ipos = ipos+1
+        y(ind(i)) = x(ipos)
+      ELSE
+        IF (ind(i) > nbo) ma_fufill_r11  = ma_fufill_r11+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r11  = ma_fufill_r11+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r11  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r11
+!===
+INTEGER FUNCTION ma_fucoll_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r11 = 0
+    ipos = 0
+    DO i=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(i) > 0) THEN
+          ipos = ipos+1
+          y(ipos) = x(ind(i))
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r11  = ma_fucoll_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r11 = 1
+  ENDIF
+!-
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r11
+!===
+INTEGER FUNCTION ma_fuundef_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb) THEN
+    ma_fuundef_r11 = 0
+    DO i=1,nbo
+      y(i) = x(i)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r11  = ma_fuundef_r11+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r11 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r11
+!===
+INTEGER FUNCTION ma_fuonly_r11(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb,nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb),miss_val,y(nbo)
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r11 = 0
+    y(1:nbo) = miss_val
+    DO i=1,nbi
+      IF (ind(i) > 0) THEN
+        y(ind(i)) =  x(ind(i))
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r11 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r11
+!===
+!===
+SUBROUTINE mathop_r21 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operations
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb(2),nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb(1),nb(2)),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r21(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r21(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r21(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r21(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r21(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r21(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r21(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r21(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r21(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r21(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r21(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r21(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r21(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r21(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r21(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r21(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r21(nb,work_in,nb_index,nindex, &
+ &                            miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > (nb(1)*nb(2)) ) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r21(nb,work_in,nb_index,nindex, &
+ &                             miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r21(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing', &
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r21", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r21(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r21(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r21
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = SIN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sin_r21 = 0
+!----------------------
+END FUNCTION ma_sin_r21
+!===
+INTEGER FUNCTION ma_cos_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = COS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_cos_r21 = 0
+!----------------------
+END FUNCTION ma_cos_r21
+!===
+INTEGER FUNCTION ma_tan_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = TAN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_tan_r21 = 0
+!----------------------
+END FUNCTION ma_tan_r21
+!===
+  INTEGER FUNCTION ma_asin_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ASIN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_asin_r21 = 0
+!-----------------------
+END FUNCTION ma_asin_r21
+!===
+INTEGER FUNCTION ma_acos_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ACOS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_acos_r21 = 0
+!-----------------------
+END FUNCTION ma_acos_r21
+!===
+INTEGER FUNCTION ma_atan_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ATAN(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_atan_r21 = 0
+!-----------------------
+END FUNCTION ma_atan_r21
+!===
+INTEGER FUNCTION ma_exp_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = EXP(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_exp_r21 = 0
+!----------------------
+END FUNCTION ma_exp_r21
+!===
+INTEGER FUNCTION ma_log_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = LOG(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_log_r21 = 0
+!----------------------
+END FUNCTION ma_log_r21
+!===
+INTEGER FUNCTION ma_sqrt_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = SQRT(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sqrt_r21 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r21
+!===
+INTEGER FUNCTION ma_abs_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = ABS(x(i,j))
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_abs_r21 = 0
+!----------------------
+END FUNCTION ma_abs_r21
+!===
+INTEGER FUNCTION ma_chs_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*(-1.)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_chs_r21 = 0
+!----------------------
+END FUNCTION ma_chs_r21
+!===
+INTEGER FUNCTION ma_cels_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)-273.15
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_cels_r21 = 0
+!-----------------------
+END FUNCTION ma_cels_r21
+!===
+INTEGER FUNCTION ma_kelv_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)+273.15
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_kelv_r21 = 0
+!-----------------------
+END FUNCTION ma_kelv_r21
+!===
+INTEGER FUNCTION ma_deg_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*57.29577951
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_deg_r21 = 0
+!----------------------
+END FUNCTION ma_deg_r21
+!===
+INTEGER FUNCTION ma_rad_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*0.01745329252
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_rad_r21 = 0
+!----------------------
+END FUNCTION ma_rad_r21
+!===
+INTEGER FUNCTION ma_ident_r21(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,i,j,ij
+  REAL :: x(nb(1),nb(2)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_ident_r21 = 0
+!------------------------
+END FUNCTION ma_ident_r21
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)+s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_add_r21 = 0
+!----------------------
+END FUNCTION ma_add_r21
+!===
+INTEGER FUNCTION ma_sub_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)-s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_sub_r21 = 0
+!----------------------
+END FUNCTION ma_sub_r21
+!===
+INTEGER FUNCTION ma_subi_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) =  s-x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_subi_r21 = 0
+!-----------------------
+END FUNCTION ma_subi_r21
+!===
+INTEGER FUNCTION ma_mult_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)*s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_mult_r21 = 0
+!-----------------------
+END FUNCTION ma_mult_r21
+!===
+INTEGER FUNCTION ma_div_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j)/s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_div_r21 = 0
+!----------------------
+END FUNCTION ma_div_r21
+!===
+INTEGER FUNCTION ma_divi_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = s/x(i,j)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_divi_r21 = 0
+!-----------------------
+END FUNCTION ma_divi_r21
+!===
+INTEGER FUNCTION ma_power_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = x(i,j) ** s
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_power_r21 = 0
+!------------------------
+END FUNCTION ma_power_r21
+!===
+INTEGER FUNCTION ma_fumin_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = MIN(x(i,j),s)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_fumin_r21 = 0
+!------------------------
+END FUNCTION ma_fumin_r21
+!===
+INTEGER FUNCTION ma_fumax_r21(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo
+  REAL :: x(nb(1),nb(2)),s,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO j=1,nb(2)
+    DO i=1,nb(1)
+      ij = ij+1
+      y(ij) = MAX(x(i,j),s)
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)
+  ma_fumax_r21 = 0
+!------------------------
+END FUNCTION ma_fumax_r21
+!===
+INTEGER FUNCTION ma_fuscat_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ii,ipos
+!---------------------------------------------------------------------
+  ma_fuscat_r21 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb(1)*nb(2)) THEN
+    ipos = 0
+    DO ij=1,nbi
+       IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+         ipos = ipos+1
+         j = ((ipos-1)/nb(1))+1
+         i = (ipos-(j-1)*nb(1))
+         y(ind(ij)) = x(i,j)
+       ELSE
+         IF (ind(ij) > nbo) ma_fuscat_r21  = ma_fuscat_r21+1
+       ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r21  = ma_fuscat_r21+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r21  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r21
+!===
+INTEGER FUNCTION ma_fugath_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r21 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          j = ((ind(ij)-1)/nb(1))+1
+          i = (ind(ij)-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r21  = ma_fugath_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r21 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r21
+!===
+INTEGER FUNCTION ma_fufill_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ii,ipos
+!---------------------------------------------------------------------
+  ma_fufill_r21 = 0
+!-
+  IF (nbi <= nb(1)*nb(2)) THEN
+    ipos = 0
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        j = ((ipos-1)/nb(1))+1
+        i = (ipos-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j)
+      ELSE
+        IF (ind(ij) > nbo) ma_fufill_r21  = ma_fufill_r21+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r21  = ma_fufill_r21+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r21  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r21
+!===
+INTEGER FUNCTION ma_fucoll_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij,ipos
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r21 = 0
+    ipos = 0
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          j = ((ind(ij)-1)/nb(1))+1
+          i = (ind(ij)-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r21  = ma_fucoll_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r21 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r21
+!===
+INTEGER FUNCTION ma_fuundef_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)) THEN
+    ma_fuundef_r21 = 0
+    DO ij=1,nbo
+      j = ((ij-1)/nb(1))+1
+      i = (ij-(j-1)*nb(1))
+      y(ij) = x(i,j)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r21 = ma_fuundef_r21+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r21 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r21
+!===
+INTEGER FUNCTION ma_fuonly_r21(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(2),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,ij
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r21 = 0
+    y(1:nbo) = miss_val
+    DO ij=1,nbi
+      IF (ind(ij) > 0) THEN
+        j = ((ind(ij)-1)/nb(1))+1
+        i = (ind(ij)-(j-1)*nb(1))
+        y(ind(ij)) =  x(i,j)
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r21 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r21
+!===
+!===
+SUBROUTINE mathop_r31 &
+ &  (fun,nb,work_in,miss_val,nb_index,nindex,scal,nb_max,work_out)
+!---------------------------------------------------------------------
+!- This subroutines gives an interface to the various operations
+!- which are allowed. The interface is general enough to allow its use
+!- for other cases.
+!-
+!- INPUT
+!-
+!- fun      : function to be applied to the vector of data
+!- nb       : Length of input vector
+!- work_in  : Input vector of data (REAL)
+!- miss_val : The value of the missing data flag (it has to be a
+!-            maximum value, in f90 : huge( a real ))
+!- nb_index : Length of index vector
+!- nindex   : Vector of indices
+!- scal     : A scalar value for vector/scalar operations
+!- nb_max   : maximum length of output vector
+!-
+!- OUTPUT
+!-
+!- nb_max   : Actual length of output variable
+!- work_out : Output vector after the operation was applied
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: fun
+  INTEGER :: nb(3),nb_max,nb_index
+  INTEGER :: nindex(nb_index)
+  REAL :: work_in(nb(1),nb(2),nb(3)),scal,miss_val
+  REAL :: work_out(nb_max)
+!-
+  INTEGER :: ierr
+!-
+  INTRINSIC SIN,COS,TAN,ASIN,ACOS,ATAN,EXP,LOG,SQRT,ABS
+!---------------------------------------------------------------------
+  ierr = 0
+!-
+  IF (scal >= miss_val-1.) THEN
+    IF (INDEX(indexfu,fun(1:LEN_TRIM(fun))) == 0) THEN
+      SELECT CASE (fun)
+      CASE('sin')
+        ierr = ma_sin_r31(nb,work_in,nb_max,work_out)
+      CASE('cos')
+        ierr = ma_cos_r31(nb,work_in,nb_max,work_out)
+      CASE('tan')
+        ierr = ma_tan_r31(nb,work_in,nb_max,work_out)
+      CASE('asin')
+        ierr = ma_asin_r31(nb,work_in,nb_max,work_out)
+      CASE('acos')
+        ierr = ma_acos_r31(nb,work_in,nb_max,work_out)
+      CASE('atan')
+        ierr = ma_atan_r31(nb,work_in,nb_max,work_out)
+      CASE('exp')
+        ierr = ma_exp_r31(nb,work_in,nb_max,work_out)
+      CASE('log')
+        ierr = ma_log_r31(nb,work_in,nb_max,work_out)
+      CASE('sqrt')
+        ierr = ma_sqrt_r31(nb,work_in,nb_max,work_out)
+      CASE('chs')
+        ierr = ma_chs_r31(nb,work_in,nb_max,work_out)
+      CASE('abs')
+        ierr = ma_abs_r31(nb,work_in,nb_max,work_out)
+      CASE('cels')
+        ierr = ma_cels_r31(nb,work_in,nb_max,work_out)
+      CASE('kelv')
+        ierr = ma_kelv_r31(nb,work_in,nb_max,work_out)
+      CASE('deg')
+        ierr = ma_deg_r31(nb,work_in,nb_max,work_out)
+      CASE('rad')
+        ierr = ma_rad_r31(nb,work_in,nb_max,work_out)
+      CASE('ident')
+        ierr = ma_ident_r31(nb,work_in,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and no indexing', &
+ &        'but still unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+         CALL ipslerr(3,"mathop", &
+ &        'Error while executing a simple function',fun,' ')
+      ENDIF
+    ELSE
+      SELECT CASE (fun)
+      CASE('gather')
+        ierr = ma_fugath_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('scatter')
+        IF (nb_index > (nb(1)*nb(2)*nb(3))) THEN
+          work_out(1:nb_max) = miss_val
+          ierr=1
+        ELSE
+          ierr = ma_fuscat_r31(nb,work_in,nb_index,nindex, &
+ &                             miss_val,nb_max,work_out)
+        ENDIF
+      CASE('coll')
+        ierr = ma_fucoll_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('fill')
+        ierr = ma_fufill_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('undef')
+        ierr = ma_fuundef_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE('only')
+        ierr = ma_fuonly_r31(nb,work_in,nb_index,nindex, &
+ &                           miss_val,nb_max,work_out)
+      CASE DEFAULT
+        CALL ipslerr(3,"mathop", &
+ &        'scalar variable undefined and indexing', &
+ &        'was requested but with unknown function',fun)
+      END SELECT
+      IF (ierr > 0) THEN
+        CALL ipslerr(3,"mathop_r31", &
+ &        'Error while executing an indexing function',fun,' ')
+      ENDIF
+    ENDIF
+  ELSE
+    SELECT CASE (fun)
+    CASE('fumin')
+      ierr = ma_fumin_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('fumax')
+      ierr = ma_fumax_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('add')
+      ierr = ma_add_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('subi')
+      ierr = ma_subi_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('sub')
+      ierr = ma_sub_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('mult')
+      ierr = ma_mult_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('div')
+      ierr = ma_div_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('divi')
+      ierr = ma_divi_r31(nb,work_in,scal,nb_max,work_out)
+    CASE('power')
+      ierr = ma_power_r31(nb,work_in,scal,nb_max,work_out)
+    CASE DEFAULT
+      CALL ipslerr(3,"mathop", &
+ &      'Unknown operation with a scalar',fun,' ')
+    END SELECT
+    IF (ierr > 0) THEN
+      CALL ipslerr(3,"mathop", &
+ &      'Error while executing a scalar function',fun,' ')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE mathop_r31
+!-
+!=== FUNCTIONS (only one argument)
+!-
+INTEGER FUNCTION ma_sin_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = SIN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sin_r31 = 0
+!----------------------
+END FUNCTION ma_sin_r31
+!===
+INTEGER FUNCTION ma_cos_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = COS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_cos_r31 = 0
+!----------------------
+END FUNCTION ma_cos_r31
+!===
+INTEGER FUNCTION ma_tan_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = TAN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_tan_r31 = 0
+!----------------------
+END FUNCTION ma_tan_r31
+!===
+INTEGER FUNCTION ma_asin_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ASIN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_asin_r31 = 0
+!-----------------------
+END FUNCTION ma_asin_r31
+!===
+INTEGER FUNCTION ma_acos_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ACOS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_acos_r31 = 0
+!-----------------------
+END FUNCTION ma_acos_r31
+!===
+INTEGER FUNCTION ma_atan_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ATAN(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_atan_r31 = 0
+!-----------------------
+  END FUNCTION ma_atan_r31
+!===
+INTEGER FUNCTION ma_exp_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = EXP(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_exp_r31 = 0
+!----------------------
+END FUNCTION ma_exp_r31
+!===
+INTEGER FUNCTION ma_log_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = LOG(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_log_r31 = 0
+!----------------------
+END FUNCTION ma_log_r31
+!===
+INTEGER FUNCTION ma_sqrt_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = SQRT(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sqrt_r31 = 0
+!-----------------------
+END FUNCTION ma_sqrt_r31
+!===
+INTEGER FUNCTION ma_abs_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = ABS(x(i,j,k))
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_abs_r31 = 0
+!----------------------
+END FUNCTION ma_abs_r31
+!===
+INTEGER FUNCTION ma_chs_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*(-1.)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_chs_r31 = 0
+!----------------------
+END FUNCTION ma_chs_r31
+!===
+INTEGER FUNCTION ma_cels_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)-273.15
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_cels_r31 = 0
+!-----------------------
+END FUNCTION ma_cels_r31
+!===
+INTEGER FUNCTION ma_kelv_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)+273.15
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_kelv_r31 = 0
+!-----------------------
+  END FUNCTION ma_kelv_r31
+!===
+INTEGER FUNCTION ma_deg_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*57.29577951
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_deg_r31 = 0
+!----------------------
+END FUNCTION ma_deg_r31
+!===
+INTEGER FUNCTION ma_rad_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*0.01745329252
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_rad_r31 = 0
+!----------------------
+END FUNCTION ma_rad_r31
+!===
+INTEGER FUNCTION ma_ident_r31(nb,x,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,i,j,k,ij
+  REAL :: x(nb(1),nb(2),nb(3)),y(nbo)
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_ident_r31 = 0
+!------------------------
+END FUNCTION ma_ident_r31
+!-
+!=== OPERATIONS (two argument)
+!-
+INTEGER FUNCTION ma_add_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)+s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_add_r31 = 0
+!----------------------
+END FUNCTION ma_add_r31
+!===
+INTEGER FUNCTION ma_sub_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)-s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_sub_r31 = 0
+!----------------------
+END FUNCTION ma_sub_r31
+!===
+INTEGER FUNCTION ma_subi_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) =  s-x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_subi_r31 = 0
+!-----------------------
+END FUNCTION ma_subi_r31
+!===
+INTEGER FUNCTION ma_mult_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)*s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_mult_r31 = 0
+!-----------------------
+END FUNCTION ma_mult_r31
+!===
+INTEGER FUNCTION ma_div_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)/s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_div_r31 = 0
+!----------------------
+END FUNCTION ma_div_r31
+!===
+INTEGER FUNCTION ma_divi_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = s/x(i,j,k)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_divi_r31 = 0
+!-----------------------
+END FUNCTION ma_divi_r31
+!===
+INTEGER FUNCTION ma_power_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = x(i,j,k)**s
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_power_r31 = 0
+!------------------------
+END FUNCTION ma_power_r31
+!===
+INTEGER FUNCTION ma_fumin_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = MIN(x(i,j,k),s)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_fumin_r31 = 0
+!------------------------
+END FUNCTION ma_fumin_r31
+!===
+INTEGER FUNCTION ma_fumax_r31(nb,x,s,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo
+  REAL :: x(nb(1),nb(2),nb(3)),s,y(nbo)
+!-
+  INTEGER :: i,j,k,ij
+!---------------------------------------------------------------------
+  ij = 0
+  DO k=1,nb(3)
+    DO j=1,nb(2)
+      DO i=1,nb(1)
+        ij = ij+1
+        y(ij) = MAX(x(i,j,k),s)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  nbo = nb(1)*nb(2)*nb(3)
+  ma_fumax_r31 = 0
+!------------------------
+END FUNCTION ma_fumax_r31
+!===
+INTEGER FUNCTION ma_fuscat_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
+!---------------------------------------------------------------------
+  ma_fuscat_r31 = 0
+!-
+  y(1:nbo) = miss_val
+!-
+  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        k = ((ipos-1)/isb)+1
+        ipp = ipos-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ELSE
+        IF (ind(ij) > nbo) ma_fuscat_r31  = ma_fuscat_r31+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fuscat_r31  = ma_fuscat_r31+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fuscat_r31  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuscat_r31
+!===
+INTEGER FUNCTION ma_fugath_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipos,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fugath_r31 = 0
+    y(1:nbo) = miss_val
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          k = ((ind(ij)-1)/isb)+1
+          ipp = ind(ij)-(k-1)*isb
+          j = ((ipp-1)/nb(1))+1
+          i = (ipp-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j,k)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fugath_r31  = ma_fugath_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fugath_r31 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fugath_r31
+!===
+INTEGER FUNCTION ma_fufill_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ii,ipos,ipp,isb
+!---------------------------------------------------------------------
+  ma_fufill_r31 = 0
+  IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
+        ipos = ipos+1
+        k = ((ipos-1)/isb)+1
+        ipp = ipos-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ELSE
+        IF (ind(ij) > nbo) ma_fufill_r31  = ma_fufill_r31+1
+      ENDIF
+    ENDDO
+!-- Repeat the data if needed
+    IF (MINVAL(ind) < 0) THEN
+      DO i=1,nbi
+        IF (ind(i) <= 0) THEN
+          DO ii=1,ABS(ind(i))-1
+            IF (ind(i+1)+ii <= nbo) THEN
+              y(ind(i+1)+ii) = y(ind(i+1))
+            ELSE
+              ma_fufill_r31  = ma_fufill_r31+1
+            ENDIF
+          ENDDO
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+    ma_fufill_r31  = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fufill_r31
+!===
+INTEGER FUNCTION ma_fucoll_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipos,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo) THEN
+    ma_fucoll_r31 = 0
+    ipos = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ipos+1 <= nbo) THEN
+        IF (ind(ij) > 0) THEN
+          k = ((ind(ij)-1)/isb)+1
+          ipp = ind(ij)-(k-1)*isb
+          j = ((ipp-1)/nb(1))+1
+          i = (ipp-(j-1)*nb(1))
+          ipos = ipos+1
+          y(ipos) = x(i,j,k)
+        ENDIF
+      ELSE
+        IF (ipos+1 > nbo) ma_fucoll_r31  = ma_fucoll_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fucoll_r31 = 1
+  ENDIF
+  nbo = ipos
+!-------------------------
+END FUNCTION ma_fucoll_r31
+!===
+INTEGER FUNCTION ma_fuundef_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipp,isb
+!---------------------------------------------------------------------
+  IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)*nb(3)) THEN
+    ma_fuundef_r31 = 0
+    isb = nb(1)*nb(2)
+    DO ij=1,nbo
+      k = ((ij-1)/isb)+1
+      ipp = ij-(k-1)*isb
+      j = ((ipp-1)/nb(1))+1
+      i = (ipp-(j-1)*nb(1))
+      y(ij) = x(i,j,k)
+    ENDDO
+    DO i=1,nbi
+      IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
+        y(ind(i)) =  miss_val
+      ELSE
+        IF (ind(i) > nbo) ma_fuundef_r31  = ma_fuundef_r31+1
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuundef_r31 = 1
+  ENDIF
+!--------------------------
+END FUNCTION ma_fuundef_r31
+!===
+INTEGER FUNCTION ma_fuonly_r31(nb,x,nbi,ind,miss_val,nbo,y)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: nb(3),nbo,nbi
+  INTEGER :: ind(nbi)
+  REAL :: x(nb(1),nb(2),nb(3)),miss_val,y(nbo)
+!-
+  INTEGER :: i,j,k,ij,ipp,isb
+!---------------------------------------------------------------------
+  IF (     (nbi <= nbo).AND.(nbo == nb(1)*nb(2)*nb(3)) &
+ &    .AND.ALL(ind(1:nbi) <= nbo) ) THEN
+    ma_fuonly_r31 = 0
+    y(1:nbo) = miss_val
+    isb = nb(1)*nb(2)
+    DO ij=1,nbi
+      IF (ind(ij) > 0) THEN
+        k = ((ind(ij)-1)/isb)+1
+        ipp = ind(ij)-(k-1)*isb
+        j = ((ipp-1)/nb(1))+1
+        i = (ipp-(j-1)*nb(1))
+        y(ind(ij)) = x(i,j,k)
+      ENDIF
+    ENDDO
+  ELSE
+    ma_fuonly_r31 = 1
+  ENDIF
+!-------------------------
+END FUNCTION ma_fuonly_r31
+!===
+SUBROUTINE moycum (opp,np,px,py,pwx)
+!---------------------------------------------------------------------
+!- Does time operations
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=7) :: opp
+  INTEGER :: np
+  REAL,DIMENSION(:) :: px,py
+  INTEGER :: pwx
+!---------------------------------------------------------------------
+  IF (pwx /= 0) THEN
+    IF      (opp == 'ave') THEN
+      px(1:np)=(px(1:np)*pwx+py(1:np))/REAL(pwx+1)
+    ELSE IF (opp == 't_sum') THEN
+      px(1:np)=px(1:np)+py(1:np)
+    ELSE IF ( (opp == 'l_min').OR.(opp == 't_min') ) THEN
+      px(1:np)=MIN(px(1:np),py(1:np))
+    ELSE IF ( (opp == 'l_max').OR.(opp == 't_max') ) THEN
+      px(1:np)=MAX(px(1:np),py(1:np))
+    ELSE
+      CALL ipslerr(3,"moycum",'Unknown time operation',opp,' ')
+    ENDIF
+  ELSE
+    IF      (opp == 'l_min') THEN
+      px(1:np)=MIN(px(1:np),py(1:np))
+    ELSE IF (opp == 'l_max') THEN
+      px(1:np)=MAX(px(1:np),py(1:np))
+    ELSE
+      px(1:np)=py(1:np)
+    ENDIF
+  ENDIF
+!--------------------
+END SUBROUTINE moycum
+!===
+!-----------------
+END MODULE mathelp
Index: vendors/IOIPSL/src/nc4interface.F90
===================================================================
--- vendors/IOIPSL/src/nc4interface.F90	(revision 9621)
+++ vendors/IOIPSL/src/nc4interface.F90	(revision 9621)
@@ -0,0 +1,124 @@
+MODULE nc4interface
+!-
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+#if ! defined key_netcdf4
+      !!--------------------------------------------------------------------
+      !! NOT 'key_netcdf4' Defines dummy routines for netcdf4
+      !!                   calls when compiling without netcdf4 libraries
+      !!--------------------------------------------------------------------
+  !- netcdf4 chunking control structure
+  !- (optional on histbeg and histend calls)
+!$AGRIF_DO_NOT_TREAT
+  TYPE, PUBLIC :: snc4_ctl
+     SEQUENCE
+     INTEGER :: ni
+     INTEGER :: nj
+     INTEGER :: nk
+     LOGICAL :: luse
+  END TYPE snc4_ctl
+!$AGRIF_END_DO_NOT_TREAT
+
+CONTAINS
+!===
+   SUBROUTINE GET_NF90_SYMBOL(sym_name, ivalue)
+      CHARACTER(len=*),      INTENT(in)  :: sym_name
+      INTEGER,               INTENT(out) :: ivalue
+      ivalue = -999
+   END SUBROUTINE GET_NF90_SYMBOL
+   INTEGER FUNCTION SET_NF90_DEF_VAR_CHUNKING(idum1, idum2, idum3, iarr1)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_CHUNKING  ***
+      !!
+      !! ** Purpose :   Dummy NetCDF4 routine to enable compiling with NetCDF3 libraries
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: idum1, idum2, idum3
+      INTEGER, DIMENSION(4), INTENT(in) :: iarr1
+      WRITE(*,*) 'Warning: Attempt to chunk output variable without NetCDF4 support'
+      SET_NF90_DEF_VAR_CHUNKING = -1
+   END FUNCTION SET_NF90_DEF_VAR_CHUNKING
+
+   INTEGER FUNCTION SET_NF90_DEF_VAR_DEFLATE(idum1, idum2, idum3, idum4, idum5)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_DEFLATE  ***
+      !!
+      !! ** Purpose :   Dummy NetCDF4 routine to enable compiling with NetCDF3 libraries
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: idum1, idum2, idum3, idum4, idum5
+      WRITE(*,*) 'Warning: Attempt to compress output variable without NetCDF4 support'
+      SET_NF90_DEF_VAR_DEFLATE = -1
+   END FUNCTION SET_NF90_DEF_VAR_DEFLATE
+#else
+      !!--------------------------------------------------------------------
+      !! 'key_netcdf4' Dummy module (usually defines dummy routines for netcdf4
+      !!               calls when compiling without netcdf4 libraries
+      !!--------------------------------------------------------------------
+
+   USE netcdf
+
+   !- netcdf4 chunking control structure
+   !- (optional on histbeg and histend calls)
+!$AGRIF_DO_NOT_TREAT
+   TYPE, PUBLIC :: snc4_ctl
+      SEQUENCE
+      INTEGER :: ni
+      INTEGER :: nj
+      INTEGER :: nk
+      LOGICAL :: luse
+   END TYPE snc4_ctl
+!$AGRIF_END_DO_NOT_TREAT
+
+CONTAINS
+   INTEGER FUNCTION SET_NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_CHUNKING  ***
+      !!
+      !! ** Purpose :   Interface NetCDF4 routine to enable compiling with NetCDF4 libraries
+      !!                but no key_netcdf4
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: nfid
+      INTEGER,               INTENT(in) :: nvid
+      INTEGER,               INTENT(in) :: ichunkalg
+      INTEGER, DIMENSION(:), INTENT(in) :: ichunksz
+      !!
+      INTEGER                           :: iret
+      !!
+      iret = NF90_DEF_VAR_CHUNKING(nfid, nvid, ichunkalg, ichunksz)
+      SET_NF90_DEF_VAR_CHUNKING = iret
+   END FUNCTION SET_NF90_DEF_VAR_CHUNKING
+
+   INTEGER FUNCTION SET_NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+      !!--------------------------------------------------------------------
+      !!                   ***  SUBROUTINE NF90_DEF_VAR_DEFLATE  ***
+      !!
+      !! ** Purpose :   Interface NetCDF4 routine to enable compiling with NetCDF4 libraries
+      !!                but no key_netcdf4
+      !!--------------------------------------------------------------------
+      INTEGER,               INTENT(in) :: nfid
+      INTEGER,               INTENT(in) :: nvid
+      INTEGER,               INTENT(in) :: ishuffle
+      INTEGER,               INTENT(in) :: ideflate
+      INTEGER,               INTENT(in) :: ideflate_level
+      !!
+      INTEGER                           :: iret
+      !!
+      iret = NF90_DEF_VAR_DEFLATE(nfid, nvid, ishuffle, ideflate, ideflate_level)
+      SET_NF90_DEF_VAR_DEFLATE = iret
+   END FUNCTION SET_NF90_DEF_VAR_DEFLATE
+
+   SUBROUTINE GET_NF90_SYMBOL(sym_name, ivalue)
+      CHARACTER(len=*),      INTENT(in)  :: sym_name
+      INTEGER,               INTENT(out) :: ivalue
+      SELECT CASE (sym_name)
+         CASE ("NF90_HDF5")
+            ivalue = NF90_HDF5
+         CASE DEFAULT
+            WRITE(*,*) "Warning: unknown case in GET_NF90_SYMBOL"
+      END SELECT
+   END SUBROUTINE GET_NF90_SYMBOL
+#endif
+
+!------------------
+END MODULE nc4interface
Index: vendors/IOIPSL/src/restcom.f90
===================================================================
--- vendors/IOIPSL/src/restcom.f90	(revision 9621)
+++ vendors/IOIPSL/src/restcom.f90	(revision 9621)
@@ -0,0 +1,2546 @@
+MODULE restcom
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+USE netcdf
+!-
+USE errioipsl, ONLY : ipslerr,ipsldbg
+USE stringop
+USE calendar
+USE mathelp
+USE fliocom,   ONLY : flio_dom_file,flio_dom_att
+!-
+IMPLICIT NONE
+!-
+PRIVATE
+!-
+PUBLIC :: &
+ &  restini, restget, restput, restclo, &
+ &  ioconf_setatt, ioget_vname, ioconf_expval, &
+ &  ioget_expval, ioget_vdim
+!-
+INTERFACE restput
+  MODULE PROCEDURE &
+ &  restput_r3d, restput_r2d, restput_r1d, &
+ &  restput_opp_r2d, restput_opp_r1d
+END INTERFACE
+!-
+INTERFACE restget
+  MODULE PROCEDURE &
+ &  restget_r3d,restget_r2d,restget_r1d, &
+ &  restget_opp_r2d,restget_opp_r1d
+END INTERFACE
+!-
+! We do not use allocatable arrays because these sizes are safe
+! and we do not know from start how many variables will be in
+! the out file.
+!-
+  INTEGER,PARAMETER :: &
+ &  max_var=500, max_file=50, max_dim=NF90_MAX_VAR_DIMS
+!-
+  CHARACTER(LEN=9),SAVE :: calend_str='unknown'
+!-
+! The IDs of the netCDF files are going in pairs.
+! The input one (netcdf_id(?,1)) and the output one (netcdf_id(?,2))
+!-
+  INTEGER,SAVE :: nb_fi = 0
+  INTEGER,DIMENSION(max_file,2),SAVE :: netcdf_id = -1
+!-
+! Description of the content of the 'in' files and the 'out' files.
+!   Number of variables   : nbvar_*
+!   Number of dimensions  : nbdim_*
+!   ID of the time axis   : tdimid_*
+!-
+  INTEGER,SAVE :: nbvar_in(max_file), nbvar_out(max_file)
+  INTEGER,SAVE :: tdimid_in(max_file), tdimid_out(max_file)
+!-
+! Variables for one or the other file
+!-
+! Number of dimensions in the input file               : nbdim_in
+! Number of variables read so far from the input file  : nbvar_read
+! Type of variable read from the input file            : vartyp_in
+!   (Could be used later to test if we have a restart file)
+!-
+  INTEGER,SAVE :: nbdim_in(max_file), nbvar_read(max_file)
+  INTEGER,SAVE :: vartyp_in(max_file, max_var)
+!-
+! Time step and time origine in the input file.
+!-
+  REAL,DIMENSION(max_file),SAVE :: deltat,timeorig
+!-
+! Description of the axes in the output file
+!-
+!   tstp_out  : Index on the tie axis currently beeing written
+!   itau_out  : Time step which is written on this index of the file
+!-
+  INTEGER,DIMENSION(max_file),SAVE :: tstp_out,itau_out
+!-
+! Description of the axes in the output file
+!-
+! For the ?ax_infs variable the following order is used :
+!   ?ax_infs (if,in,1) = size of axis
+!   ?ax_infs (if,in,2) = id of dimension
+! Number of x,y and z axes in the output file :
+!   ?ax_nb(if)
+!-
+  INTEGER,DIMENSION(max_file,max_dim,2),SAVE :: &
+ &  xax_infs,yax_infs,zax_infs
+  INTEGER,DIMENSION(max_file),SAVE :: &
+ &  xax_nb=0,yax_nb=0,zax_nb=0
+!-
+! Description of the time axes in the input and output files
+!-
+!   ID of the variable which contains the itaus :
+!     tind_varid_*
+!   ID of the variables which contains the seconds since date :
+!     tax_varid_*
+!   Size of the time axis in the input file :
+!     tax_size_in
+!-
+  INTEGER,SAVE :: tind_varid_in(max_file),  tax_varid_in(max_file), &
+ &                tind_varid_out(max_file), tax_varid_out(max_file)
+  INTEGER,SAVE :: tax_size_in(max_file)=1
+!-
+! The two time axes we have in the input file :
+!   t_index   : dates in itaus
+!               (thus the variable has a tstep_sec attribute)
+!   t_julian  : Julian days of the time axis
+!-
+  INTEGER,SAVE,ALLOCATABLE :: t_index(:,:)
+  REAL,SAVE,ALLOCATABLE :: t_julian(:,:)
+!-
+! Here we save a number of informations on the variables
+! in the files we are handling
+!-
+! Name of variables :                                    varname_*
+! ID of the variables :                                  varid_*
+! Number of dimensions of the variable :                 varnbdim_*
+! Dimensions which are used for the variable :           vardims_*
+! Number of attributes for a variables :                 varatt_*
+! A flag which markes the variables we have worked on :  touched_*
+!-
+  CHARACTER(LEN=20),DIMENSION(max_file,max_var),SAVE :: &
+ &  varname_in,varname_out
+  INTEGER,DIMENSION(max_file,max_var),SAVE :: &
+ &  varid_in,varid_out,varnbdim_in,varatt_in
+  INTEGER,DIMENSION(max_file,max_var,max_dim),SAVE :: &
+ &  vardims_in
+  LOGICAL,DIMENSION(max_file,max_var),SAVE :: &
+ &  touched_in,touched_out
+!-
+  CHARACTER(LEN=120),SAVE :: indchfun= 'scatter, fill, gather, coll'
+  REAL,PARAMETER :: missing_val=1.e20
+!                or HUGE(1.0) (maximum real number)
+!-
+! The default value we will use for variables
+! which are not present in the restart file
+!-
+  REAL,SAVE :: val_exp =  999999.
+  LOGICAL,SAVE :: lock_valexp = .FALSE.
+!-
+! Temporary variables in which we store the attributed which are going
+! to be given to a new variable which is going to be defined.
+!-
+  CHARACTER(LEN=80),SAVE :: rest_units='XXXXX',rest_lname='XXXXX'
+!-
+! For allocations
+!-
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp1,buff_tmp2
+!-
+!===
+CONTAINS
+!===
+!-
+SUBROUTINE restini &
+ & (fnamein,iim,jjm,lon,lat,llm,lev, &
+ &  fnameout,itau,date0,dt,fid,owrite_time_in,domain_id)
+!---------------------------------------------------------------------
+!- This subroutine sets up all the restart process.
+!- It will call the subroutine which opens the input
+!- and output files.
+!- The time step (itau), date of origine (date0) and time step are
+!- READ from the input file.
+!- A file ID, which is common to the input and output file is returned
+!-
+!- If fnamein = fnameout then the same file is used for the reading
+!- the restart conditions and writing the new restart.
+!-
+!- A special mode can be switched in with filename='NONE'.
+!- This means that no restart file is present.
+!- Usefull for creating the first restart file
+!- or to get elements in a file without creating an output file.
+!-
+!- A mode needs to be written in which itau, date0 and dt
+!- are given to the restart process and thus
+!- written into the output restart file.
+!-
+!- INPUT
+!-
+!- fnamein  : name of the file for the restart
+!- iim      : Dimension in x
+!- jjm      : Dimension in y
+!- lon      : Longitude in the x,y domain
+!- lat      : Latitude in the x,y domain
+!- llm      : Dimension in the vertical
+!- lev      : Positions of the levels
+!- fnameout :
+!-
+!- OUTPUT
+!-
+!- itau     : Time step of the restart file and at which the model
+!-            should restart
+!- date0    : Time at which itau = 0
+!- dt       : time step in seconds between two succesiv itaus
+!- fid      : File identification of the restart file
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!- domain_id      : Domain identifier
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: fnamein,fnameout
+  INTEGER :: iim,jjm,llm,fid,itau
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  REAL :: date0,dt
+  LOGICAL,OPTIONAL :: owrite_time_in
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: ncfid
+  REAL :: dt_tmp,date0_tmp
+  LOGICAL :: l_fi,l_fo,l_rw
+  LOGICAL :: overwrite_time
+  CHARACTER(LEN=120) :: fname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Prepare the configuration before opening any files
+!-
+  IF (.NOT.PRESENT(owrite_time_in)) THEN
+    overwrite_time = .FALSE.
+  ELSE
+    overwrite_time = owrite_time_in
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.0 : ',TRIM(fnamein),' , ',TRIM(fnameout)
+  ENDIF
+!-
+  nb_fi = nb_fi+1
+!-
+  IF (nb_fi > max_file) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Too many restart files are used. The problem can be',&
+ &   'solved by increasing max_file in restcom.f90 ',&
+ &   'and recompiling ioipsl.')
+  ENDIF
+!-
+! 0.1 Define the open flags
+!-
+  l_fi = (TRIM(fnamein)  /= 'NONE')
+  l_fo = (TRIM(fnameout) /= 'NONE')
+  IF ((.NOT.l_fi).AND.(.NOT.l_fo)) THEN
+    CALL ipslerr (3,'restini',&
+ &   'Input and output file names are both to NONE.',&
+ &   'It is probably an error.','Verify your logic.')
+  ENDIF
+  l_rw = l_fi.AND.l_fo.AND.(TRIM(fnamein) == TRIM(fnameout))
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 0.1 l_fi, l_fo, l_rw : ',l_fi,l_fo,l_rw
+  ENDIF
+!-
+! 1.0 Open the input file.
+!-
+  IF (l_fi) THEN
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 1.0 : Open input file'
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnamein
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenin (nb_fi,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+    netcdf_id(nb_fi,1) = ncfid
+!---
+!-- 1.3 Extract the time information
+!---
+    IF (overwrite_time) THEN
+       date0_tmp = date0
+    ENDIF
+    CALL restsett (dt_tmp,date0_tmp,itau,overwrite_time)
+    IF (.NOT.overwrite_time) THEN
+      dt = dt_tmp
+      date0 = date0_tmp
+    ENDIF
+!---
+  ELSE
+!---
+!-- 2.0 The case of a missing restart file is dealt with
+!---
+    IF (l_dbg) WRITE(*,*) 'restini 2.0'
+!---
+    IF (     (ALL(MINLOC(lon(:iim,:jjm)) == MAXLOC(lon(:iim,:jjm)))) &
+        .AND.(iim > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the longitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lat(:iim,:jjm)) == MAXLOC(lat(:iim,:jjm)))) &
+        .AND.(jjm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the latitudes of the',&
+        & 'grid need to be provided to restini. This ',&
+        & 'information is needed for the restart files')
+    ENDIF
+    IF (     (ALL(MINLOC(lev(:llm)) == MAXLOC(lev(:llm)))) &
+        .AND.(llm > 1) ) THEN
+      CALL ipslerr (3,'restini',&
+        & 'For creating a restart file the levels of the',&
+        & 'grid need to be provided to restini. This',&
+        & 'information is needed for the restart files')
+    ENDIF
+!---
+!-- 2.2 Allocate the time axes and write the inputed variables
+!---
+    tax_size_in(nb_fi) = 1
+    CALL rest_atim (l_dbg,'restini')
+    t_index(nb_fi,1) = itau
+    t_julian(nb_fi,1) = date0
+  ENDIF
+!-
+  IF (l_fo.AND.(.NOT.l_rw)) THEN
+!-- Add DOMAIN number and ".nc" suffix in file names if needed
+    fname = fnameout
+    CALL flio_dom_file (fname,domain_id)
+!-- Open the file
+    CALL restopenout &
+      (nb_fi,fname,iim,jjm,lon,lat,llm,lev,dt,date0,ncfid,domain_id)
+    netcdf_id(nb_fi,2) = ncfid
+  ELSE IF (l_fi.AND.l_fo) THEN
+    netcdf_id(nb_fi,2) = netcdf_id(nb_fi,1)
+    varname_out(nb_fi,:) = varname_in(nb_fi,:)
+    nbvar_out(nb_fi) = nbvar_in(nb_fi)
+    tind_varid_out(nb_fi) = tind_varid_in(nb_fi)
+    tax_varid_out(nb_fi) = tax_varid_in(nb_fi)
+    varid_out(nb_fi,:) = varid_in(nb_fi,:)
+    touched_out(nb_fi,:) = .TRUE.
+  ENDIF
+!-
+! 2.3 Set the calendar for the run.
+!     This should not produce any error message if
+!     This does not mean any change in calendar
+!     (to be modified in ioconf_calendar)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restini 2.3 : Configure calendar if needed : ', &
+                calend_str
+  ENDIF
+!-
+  IF (INDEX(calend_str,'unknown') < 1) THEN
+    CALL ioconf_calendar (calend_str)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restini 2.3b : new calendar : ',calend_str
+    ENDIF
+  ENDIF
+!-
+! Save some data in the module
+!-
+  deltat(nb_fi) = dt
+!-
+! Prepare the variables which will be returned
+!-
+  fid = nb_fi
+  IF (l_dbg) THEN
+    WRITE(*,*) 'SIZE of t_index :',SIZE(t_index), &
+               SIZE(t_index,dim=1),SIZE(t_index,dim=2)
+    WRITE(*,*) 't_index = ',t_index(fid,:)
+  ENDIF
+  itau = t_index(fid,1)
+!-
+  IF (l_dbg) WRITE(*,*) 'restini END'
+!---------------------
+END SUBROUTINE restini
+!===
+SUBROUTINE restopenin &
+  (fid,fname,l_rw,iim,jjm,lon,lat,llm,lev,ncfid)
+!---------------------------------------------------------------------
+!- Opens the restart file and checks that it belongsd to the model.
+!- This means that the coordinates of the model are compared to the
+!- ones in the file.
+!-
+!- The number and name of variable in the file are exctracted. Also
+!- the time details.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*),INTENT(IN) :: fname
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  LOGICAL,INTENT(IN) :: l_rw
+  INTEGER,INTENT(OUT) :: ncfid
+!-
+  INTEGER,DIMENSION(max_dim) :: var_dims,dimlen
+  INTEGER :: nb_dim,nb_var,id_unl,id,iv
+  INTEGER :: iread,jread,lread,iret
+  INTEGER :: lon_vid,lat_vid
+  REAL :: lon_read(iim,jjm),lat_read(iim,jjm)
+  REAL :: lev_read(llm)
+  REAL :: mdlon,mdlat
+  CHARACTER(LEN=80) :: units
+  CHARACTER(LEN=NF90_max_name),DIMENSION(max_dim) :: dimname
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! If we reuse the same file for input and output
+! then we open it in write mode
+!-
+  IF (l_rw) THEN; id = NF90_WRITE; ELSE; id = NF90_NOWRITE; ENDIF
+  iret = NF90_OPEN(fname,id,ncfid)
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restopenin','Could not open file :',fname,' ')
+  ENDIF
+!-
+  IF (l_dbg) WRITE (*,*) "restopenin 0.0 ",TRIM(fname)
+  iret = NF90_INQUIRE(ncfid,nDimensions=nb_dim, &
+ &         nVariables=nb_var,unlimitedDimId=id_unl)
+  tdimid_in(fid) = id_unl
+!-
+  IF (nb_dim > max_dim) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More dimensions present in file that can be store',&
+      & 'Please increase max_dim in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+  IF (nb_var > max_var) THEN
+    CALL ipslerr (3,'restopenin',&
+      & 'More variables present in file that can be store',&
+      & 'Please increase max_var in the global variables ',&
+      & 'in restcom.F90')
+  ENDIF
+!-
+  nbvar_in(fid) = nb_var
+  nbdim_in(fid) = nb_dim
+  iread = -1; jread = -1; lread = -1;
+  DO id=1,nb_dim
+    iret = NF90_INQUIRE_DIMENSION(ncfid,id, &
+ &           len=dimlen(id),name=dimname(id))
+    IF (l_dbg) THEN
+      WRITE (*,*) "restopenin 0.0 dimname",id,TRIM(dimname(id))
+    ENDIF
+    IF      (TRIM(dimname(id)) == 'x') THEN
+      iread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "iread",iread
+    ELSE IF (TRIM(dimname(id)) == 'y') THEN
+      jread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "jread",jread
+    ELSE IF (TRIM(dimname(id)) == 'z') THEN
+      lread = dimlen(id)
+      IF (l_dbg) WRITE (*,*) "lread",lread
+    ENDIF
+  ENDDO
+!-
+  IF (id_unl > 0) THEN
+!---
+!-- 0.1 If we are going to add values to this file
+!--     we need to know where it ends
+!--     We also need to have all the dimensions in the file
+!---
+    IF (l_rw) THEN
+      tstp_out(fid) = dimlen(id_unl)
+      itau_out(fid) = -1
+      tdimid_out(fid) =  tdimid_in(fid)
+      IF (l_dbg) THEN
+        WRITE (*,*) &
+ &       "restopenin 0.0 unlimited axis dimname", &
+ &       dimname(id_unl),tstp_out(fid)
+      ENDIF
+!-----
+      xax_nb(fid) = 0
+      yax_nb(fid) = 0
+      zax_nb(fid) = 0
+!-----
+      DO id=1,nb_dim
+        IF      (dimname(id)(1:1) == 'x') THEN
+          xax_nb(fid) = xax_nb(fid)+1
+          xax_infs(fid,xax_nb(fid),1) = dimlen(id)
+          xax_infs(fid,xax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'y') THEN
+          yax_nb(fid) = yax_nb(fid)+1
+          yax_infs(fid,yax_nb(fid),1) = dimlen(id)
+          yax_infs(fid,yax_nb(fid),2) = id
+        ELSE IF (dimname(id)(1:1) == 'z') THEN
+          zax_nb(fid) = zax_nb(fid)+1
+          zax_infs(fid,zax_nb(fid),1) = dimlen(id)
+          zax_infs(fid,zax_nb(fid),2) = id
+        ENDIF
+      ENDDO
+    ENDIF
+  ELSE
+!---
+!-- Still need to find a method for dealing with this
+!---
+!  CALL ipslerr (3,'restopenin',&
+!    & ' We do not deal yet with files without time axis.',' ',' ')
+  ENDIF
+!-
+! 1.0 First let us check that we have the righ restart file
+!-
+  IF ((iread /= iim).OR.(jread /= jjm).OR.(lread /= llm)) THEN
+    CALL ipslerr (3,'restopenin',&
+ &    'The grid of the restart file does not correspond',&
+ &    'to that of the model',' ')
+  ENDIF
+!-
+! 2.0 Get the list of variables
+!-
+  IF (l_dbg) WRITE(*,*) 'restopenin 1.2'
+!-
+  lat_vid = -1
+  lon_vid = -1
+  tind_varid_in(fid) = -1
+  tax_varid_in(fid) = -1
+!-
+  DO iv=1,nb_var
+!---
+    varid_in(fid,iv) = iv
+    var_dims(:) = 0
+    iret = NF90_INQUIRE_VARIABLE(ncfid,iv, &
+ &           name=varname_in(fid,iv),xtype=vartyp_in(fid,iv), &
+ &           ndims=varnbdim_in(fid,iv),dimids=var_dims, &
+ &           nAtts=varatt_in(fid,iv))
+!---
+    DO id=1,varnbdim_in(fid,iv)
+      iret = NF90_INQUIRE_DIMENSION &
+ &             (ncfid,var_dims(id),len=vardims_in(fid,iv,id))
+    ENDDO
+!---
+!-- 2.1 Read the units of the variable
+!---
+    units=''
+    iret = NF90_GET_ATT(ncfid,iv,'units',units)
+    CALL strlowercase (units)
+    CALL cmpblank (units)
+!---
+!-- 2.2 Catch the time variables
+!---
+    IF (varnbdim_in(fid,iv) == 1) THEN
+      IF (     (INDEX(units,'timesteps since') > 0) &
+          .AND.(tind_varid_in(fid) < 0) ) THEN
+        tind_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+      IF (     (INDEX(units,'seconds since') > 0) &
+          .AND.(tax_varid_in(fid) < 0) ) THEN
+        tax_varid_in(fid) = iv
+        tax_size_in(fid) = vardims_in(fid,iv,1)
+      ENDIF
+    ENDIF
+!---
+!-- 2.3 Catch longitude and latitude variables
+!---
+    IF      (INDEX(units,'degrees_nort') > 0) THEN
+      lat_vid = iv
+    ELSE IF (INDEX(units,'degrees_east') > 0) THEN
+      lon_vid = iv
+    ENDIF
+!---
+  ENDDO
+!-
+! 2.4 None of the variables was yet read
+!-
+  nbvar_read(fid) = 0
+  touched_in(fid,:) = .FALSE.
+!-
+! 3.0 Reading the coordinates from the input restart file
+!-
+  lon_read = missing_val
+  lat_read = missing_val
+!-
+  IF (lon_vid < 0 .OR. lat_vid < 0) THEN
+    CALL ipslerr (3,'restopenin',&
+      & ' No variables containing longitude or latitude were ',&
+      & ' found in the restart file.',' ')
+  ELSE
+    iret = NF90_GET_VAR(ncfid,lon_vid,lon_read)
+    iret = NF90_GET_VAR(ncfid,lat_vid,lat_read)
+!---
+    IF (  (ABS( MAXVAL(lon(:,:)) &
+ &             -MINVAL(lon(:,:))) < EPSILON(MAXVAL(lon(:,:)))) &
+ &   .AND.(ABS( MAXVAL(lat(:,:)) &
+ &             -MINVAL(lat(:,:))) < EPSILON(MAXVAL(lat(:,:)))) ) THEN
+!-----
+!---- 3.1 No longitude nor latitude are provided thus
+!---- they are taken from the restart file
+!-----
+      lon(:,:) = lon_read(:,:)
+      lat(:,:) = lat_read(:,:)
+    ELSE
+!-----
+!---- 3.2 We check that the longitudes and latitudes
+!----     in the file and the model are the same
+!-----
+      mdlon = MAXVAL(ABS(lon_read-lon))
+      mdlat = MAXVAL(ABS(lat_read-lat))
+!-----
+!---- We can not test against epsilon here as the longitude
+!---- can be stored at another precision in the netCDF file.
+!---- The test here does not need to be very precise.
+!-----
+      IF (mdlon > 1.e-4 .OR. mdlat > 1.e-4) THEN
+        CALL ipslerr (3,'restopenin',&
+          & ' The longitude or latitude found in the restart ',&
+          & ' file are not the same as the ones used in the model.',&
+          & ' ')
+      ENDIF
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE restopenin
+!===
+SUBROUTINE restsett (timestep,date0,itau,owrite_time_in)
+!---------------------------------------------------------------------
+!- Here we get all the time information from the file.
+!-
+!- The time information can come in three forms :
+!- -global attributes which give the time origine and the
+!-  time step is taken from the input to restinit
+!- -A physical time exists and thus the julian date from the
+!-  input is used for positioning using the itau as input
+!- -A time-step axis exists and itau is positioned on it.
+!-
+!- What takes precedence : the model
+!-
+!- itau     : Time step of the model
+!-
+!- Optional INPUT arguments
+!-
+!- owrite_time_in : logical  argument which allows to
+!-                  overwrite the time in the restart file
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: date0,timestep
+  INTEGER :: itau
+  LOGICAL,OPTIONAL :: owrite_time_in
+!-
+  INTEGER :: ncfid,iret,it,iax,iv
+  CHARACTER(LEN=80) :: itau_orig,tax_orig,calendar
+  CHARACTER(LEN=9) :: tmp_cal
+  INTEGER :: year0,month0,day0,hours0,minutes0,seci
+  REAL :: sec0,one_day,one_year,date0_ju,ttmp
+  CHARACTER :: strc
+  LOGICAL :: ow_time
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(owrite_time_in)) THEN
+    ow_time = owrite_time_in
+  ELSE
+    ow_time = .FALSE.
+  ENDIF
+!-
+  ncfid = netcdf_id(nb_fi,1)
+!-
+! Allocate the space we need for the time axes
+!-
+  CALL rest_atim (l_dbg,'restsett')
+!-
+! Get the calendar if possible. Else it will be gregorian.
+!-
+  IF (tax_size_in(nb_fi) > 0) THEN
+    calendar = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',calendar)
+    IF (iret == NF90_NOERR) THEN
+      CALL ioconf_calendar (calendar)
+      IF (l_dbg) THEN
+        WRITE(*,*) 'restsett : calendar of the restart ',calendar
+      ENDIF
+    ENDIF
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+  IF (l_dbg) THEN
+    WRITE(*,*) 'one_year,one_day = ',one_year,one_day
+  ENDIF
+!-
+  itau_orig = 'XXXXX'
+  tax_orig  = 'XXXXX'
+!-
+! Get the time steps of the time axis if available on the restart file
+!-
+  IF (tind_varid_in(nb_fi) > 0) THEN
+    IF (ow_time) THEN
+      t_index(nb_fi,:) = itau
+      IF (l_dbg) THEN
+        WRITE(*,*) "nb_fi,t_index",nb_fi,t_index(nb_fi,:)
+      ENDIF
+      CALL ju2ymds (date0,year0,month0,day0,sec0)
+      hours0 = NINT(sec0/3600)
+      sec0 = sec0 - 3600 * hours0
+      minutes0 = NINT(sec0 / 60)
+      sec0 = sec0 - 60 * minutes0
+      seci = NINT(sec0)
+      strc=':'
+      IF (l_dbg) THEN
+        WRITE(*,*) date0
+        WRITE (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &       year0,'-',month0,'-',day0,' ',hours0,':',minutes0,':',seci
+        WRITE(*,*) "itau_orig : ",itau_orig
+      ENDIF
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      IF (l_dbg) THEN
+        WRITE(*,*) "restsett, time axis : ",t_index(nb_fi,:)
+      ENDIF
+      iret = NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'units',itau_orig)
+      itau_orig = &
+ &      itau_orig(INDEX(itau_orig,'since')+6:LEN_TRIM(itau_orig))
+      iret = &
+ &      NF90_GET_ATT(ncfid,tind_varid_in(nb_fi),'tstep_sec',timestep)
+!-----
+!---- This time origin will dominate as it is linked to the time steps.
+!-----
+      READ (UNIT=itau_orig,FMT='(I4.4,5(A,I2.2))') &
+ &      year0,strc,month0,strc,day0,strc, &
+ &      hours0,strc,minutes0,strc,seci
+      sec0 = REAL(seci)
+      sec0 = hours0*3600.+minutes0*60.+sec0
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+    ENDIF
+  ENDIF
+!-
+! If a julian day time axis is available then we get it
+!-
+  IF (tax_varid_in(nb_fi) > 0) THEN
+    iret = NF90_GET_VAR(ncfid,tax_varid_in(nb_fi),t_julian(nb_fi,:))
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'units',tax_orig)
+    tax_orig = tax_orig(INDEX(tax_orig,'since')+6:LEN_TRIM(tax_orig))
+    tmp_cal = ' '
+    iret = NF90_GET_ATT(ncfid,tax_varid_in(nb_fi),'calendar',tmp_cal)
+    IF (l_dbg) THEN
+      WRITE(*,*) 'restsett : tmp_calendar of the restart ',tmp_cal
+    ENDIF
+!---
+    CALL strlowercase (tmp_cal)
+    IF (INDEX(calend_str,tmp_cal) < 1) THEN
+      IF (INDEX(calend_str,'unknown') > 0) THEN
+        calend_str = tmp_cal
+      ELSE
+        CALL ipslerr (2,'restsett', &
+ &       ' In the restart files two different calendars were found.', &
+ &       ' Please check the files you have used.',' ')
+      ENDIF
+    ENDIF
+!---
+!-- We need to transform that into julian days
+!-- to get ride of the intial date.
+!---
+    IF (l_dbg) WRITE(*,*) 'tax_orig : ',TRIM(tax_orig)
+    READ (UNIT=tax_orig,FMT='(I4.4,5(a,I2.2))') &
+      year0,strc,month0,strc,day0,strc, &
+      hours0,strc,minutes0,strc,seci
+    sec0 = REAL(seci)
+    sec0 = hours0*3600.+minutes0*60.+sec0
+    CALL ymds2ju (year0,month0,day0,sec0,date0_ju)
+    t_julian(nb_fi,:) = t_julian(nb_fi,:)/one_day+date0_ju
+  ENDIF
+!-
+  IF (     (INDEX(itau_orig,'XXXXX') > 0) &
+      .AND.(INDEX(tax_orig,'XXXXX')  < 1) ) THEN
+!!- Compute the t_itau from the date read and the timestep in the input
+  ENDIF
+!-
+  IF (     (INDEX(tax_orig,'XXXXX')  > 0) &
+      .AND.(INDEX(itau_orig,'XXXXX') < 1) ) THEN
+    DO it=1,tax_size_in(nb_fi)
+      t_julian(nb_fi,it) = itau2date(t_index(nb_fi,it),date0,timestep)
+    ENDDO
+  ENDIF
+!-
+! If neither the indices or time is present then get global attributes
+! This is for compatibility reasons and should not be used.
+!-
+  IF ((tax_varid_in(nb_fi) < 0).AND.(tind_varid_in(nb_fi) < 0)) THEN
+    iax = -1
+    DO iv=1,nbvar_in(nb_fi)
+      IF (    (INDEX(varname_in(nb_fi,iv),'tsteps') > 0) &
+ &        .OR.(INDEX(varname_in(nb_fi,iv),'time_steps') > 0)) THEN
+        iax = iv
+      ENDIF
+    ENDDO
+!---
+    IF (iax < 0) THEN
+      CALL ipslerr (3,'restsett',&
+        & 'No time axis was found in the restart file. Please check',&
+        & 'that it corresponds to the convention used in restsett',&
+        & ' ')
+    ELSE
+      iret = NF90_GET_VAR(ncfid,tind_varid_in(nb_fi),t_index(nb_fi,:))
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'delta_tstep_sec',timestep)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'year0',ttmp)
+      year0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'month0',ttmp)
+      month0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'day0',ttmp)
+      day0 = NINT(ttmp)
+      iret = NF90_GET_ATT(ncfid,NF90_GLOBAL,'sec0',sec0)
+!---
+      CALL ymds2ju (year0,month0,day0,sec0,date0)
+      t_julian(nb_fi,1) = itau2date(t_index(nb_fi,1),date0,timestep)
+    ENDIF
+  ENDIF
+!----------------------
+END SUBROUTINE restsett
+!===
+SUBROUTINE restopenout &
+  (fid,fname,iim,jjm, &
+   lon,lat,llm,lev,timestep,date,ncfid,domain_id)
+!---------------------------------------------------------------------
+!- Opens the restart file for output.
+!- The longitude and time variables are written.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid,iim,jjm,llm
+  CHARACTER(LEN=*) :: fname
+  REAL :: date,timestep
+  REAL :: lon(iim,jjm),lat(iim,jjm),lev(llm)
+  INTEGER,INTENT(OUT) :: ncfid
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+!-
+  INTEGER :: iret
+  CHARACTER(LEN=70) :: str_t
+  INTEGER :: x_id,y_id,z_id,itauid
+  INTEGER :: nlonid,nlatid,nlevid,timeid
+  INTEGER :: year,month,day,hours,minutes
+  REAL :: sec
+  CHARACTER(LEN=3),DIMENSION(12) :: &
+    cal = (/'JAN','FEB','MAR','APR','MAY','JUN', &
+            'JUL','AUG','SEP','OCT','NOV','DEC'/)
+  CHARACTER(LEN=30) :: timenow
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 0.0 ",TRIM(fname)
+!-
+!  If we use the same file for input and output
+!- we will not even call restopenout
+!-
+  iret = NF90_CREATE(fname,NF90_NOCLOBBER,ncfid)
+  IF (iret == -35) THEN
+    CALL ipslerr (3,'restopenout',&
+      & ' The restart file aready exists on the disc. IOIPSL ',&
+      & ' will not overwrite it. You should remove the old one or ',&
+      & ' generate the new one with another name')
+  ENDIF
+!-
+  iret = NF90_DEF_DIM(ncfid,'x',iim,x_id)
+  xax_nb(fid) = xax_nb(fid)+1
+  xax_infs(fid,xax_nb(fid),1) = iim
+  xax_infs(fid,xax_nb(fid),2) = x_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'y',jjm,y_id)
+  yax_nb(fid)  = yax_nb(fid)+1
+  yax_infs(fid,yax_nb(fid),1) = jjm
+  yax_infs(fid,yax_nb(fid),2) = y_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'z',llm,z_id)
+  zax_nb(fid) = zax_nb(fid)+1
+  zax_infs(fid,zax_nb(fid),1) = llm
+  zax_infs(fid,zax_nb(fid),2) = z_id
+!-
+  iret = NF90_DEF_DIM(ncfid,'time',NF90_UNLIMITED,tdimid_out(fid))
+!-
+! 1.0 Longitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 1.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lon",NF90_FLOAT,(/x_id,y_id/),nlonid)
+  iret = NF90_PUT_ATT(ncfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_min',REAL(-180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'valid_max',REAL( 180.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlonid,'long_name',"Longitude")
+!-
+! 2.0 Latitude
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 2.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lat",NF90_FLOAT,(/x_id,y_id/),nlatid)
+  iret = NF90_PUT_ATT(ncfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_min',REAL(-90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'valid_max',REAL( 90.,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlatid,'long_name',"Latitude")
+!-
+! 3.0 Levels
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 3.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"nav_lev",NF90_FLOAT,z_id,nlevid)
+  iret = NF90_PUT_ATT(ncfid,nlevid,'units',"model_levels")
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_min', &
+ &                     REAL(MINVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'valid_max', &
+ &                     REAL(MAXVAL(lev),KIND=4))
+  iret = NF90_PUT_ATT(ncfid,nlevid,'long_name',"Model levels")
+!-
+! 4.0 Time axis, this is the seconds since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 4.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time",NF90_FLOAT, &
+                       tdimid_out(fid),timeid)
+  tax_varid_out(fid) = timeid
+!-
+  timeorig(fid) = date
+  CALL ju2ymds (date,year,month,day,sec)
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+  WRITE (UNIT=str_t, &
+   FMT='("seconds since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'units',TRIM(str_t))
+!-
+  CALL ioget_calendar (str_t)
+  iret = NF90_PUT_ATT(ncfid,timeid,'calendar',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,timeid,'title','Time')
+  iret = NF90_PUT_ATT(ncfid,timeid,'long_name','Time axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,timeid,'time_origin',TRIM(str_t))
+!-
+! 5.0 Time axis, this is the time steps since axis
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout 5.0"
+!-
+  iret = NF90_DEF_VAR(ncfid,"time_steps",NF90_INT, &
+ &                    tdimid_out(fid),itauid)
+  tind_varid_out(fid) = itauid
+!-
+  CALL ju2ymds (date,year,month,day,sec)
+!-
+  hours   = INT(sec/(60.*60.))
+  minutes = INT((sec-hours*60.*60.)/60.)
+  sec     = sec-(hours*60.*60.+minutes*60.)
+!-
+  WRITE (UNIT=str_t, &
+   FMT='("timesteps since ",I4.4,2("-",I2.2)," ",I2.2,2(":",I2.2))') &
+ &  year,month,day,hours,minutes,INT(sec)
+!-
+  iret = NF90_PUT_ATT(ncfid,itauid,'units',TRIM(str_t))
+  iret = NF90_PUT_ATT(ncfid,itauid,'title','Time steps')
+  iret = NF90_PUT_ATT(ncfid,itauid,'tstep_sec',REAL(timestep,KIND=4))
+  iret = NF90_PUT_ATT(ncfid,itauid,'long_name','Time step axis')
+!-
+  WRITE(UNIT=str_t, &
+   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,2(":",I2.2))') &
+ &  year,cal(month),day,hours,minutes,INT(sec)
+  iret = NF90_PUT_ATT(ncfid,itauid,'time_origin',TRIM(str_t))
+!-
+!  5.2 Write global attributes
+!-
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'Conventions',"CF-1.1")
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'file_name',TRIM(fname))
+!!  TO BE DONE LATER
+!!   iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL, &
+!!                       'production',TRIM(model_name))
+!!   lock_modname = .TRUE.
+  CALL ioget_timestamp (timenow)
+  iret = NF90_PUT_ATT(ncfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+!-
+! Add DOMAIN attributes if needed
+!-
+  CALL flio_dom_att (ncfid,domain_id)
+!-
+! 6.0 The coordinates are written to the file
+!-
+  iret = NF90_ENDDEF(ncfid)
+!-
+  iret = NF90_PUT_VAR(ncfid,nlonid,lon)
+  iret = NF90_PUT_VAR(ncfid,nlatid,lat)
+  iret = NF90_PUT_VAR(ncfid,nlevid,lev)
+!-
+! 7.0 Set a few variables related to the out file
+!-
+  nbvar_out(fid) = 0
+  itau_out(fid) = -1
+  tstp_out(fid) = 0
+  touched_out(fid,:) = .FALSE.
+!-
+! 7.1 The file is put back in define mode.
+!     This will last until itau_out >= 0
+!-
+  iret = NF90_REDEF(ncfid)
+!-
+  IF (l_dbg) WRITE(*,*) "restopenout END"
+!-------------------------
+END SUBROUTINE restopenout
+!===
+SUBROUTINE restget_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r1d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'Unable to performe an operation on this variable as it has',&
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restget_opp_r1d')
+!-
+! 2.0 Here we get the variable from the restart file
+!-
+  CALL restget_real &
+    (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+     zax_infs(fid,1,1),itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    CALL mathop (topp,req_sz,buff_tmp2,missing_val, &
+ &               nbindex,ijndex,scal,siz1,buff_tmp1)
+    var(:) = buff_tmp1(1:siz1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r1d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r1d
+!===
+SUBROUTINE restget_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha, &
+ &  var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!-
+!- Should work as restput_opp_r2d but the other way around !
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,var_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF (nbindex == iim  .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restget_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restget_opp_r2d')
+!-
+! 2.0 Here we get the full variable from the restart file
+!-
+  CALL restget_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,def_beha,buff_tmp2)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    var_sz = siz1
+    DO jj = 1,jjm
+      ist = (jj-1)*req_sz+1
+      CALL mathop (topp,req_sz,buff_tmp2(ist:ist+req_sz-1), &
+ &      missing_val,nbindex,ijndex,scal,var_sz,buff_tmp1)
+      var(:,jj) = buff_tmp1(1:siz1)
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'resget_opp_r2d', &
+      'The operation you wish to do on the variable for the ',&
+      'restart file is not allowed.',topp)
+  ENDIF
+!-----------------------------
+END SUBROUTINE restget_opp_r2d
+!===
+SUBROUTINE restget_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable requested from file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("the size of variable requested from file is ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    var(ji) = buff_tmp1(jl)
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r1d
+!===
+SUBROUTINE restget_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r2d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+ & (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      var(ji,jj) = buff_tmp1(jl)
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r2d
+!===
+SUBROUTINE restget_r3d &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restget_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL def_beha
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restget_r3d')
+!-
+! 2.0 Here we check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file should be ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2, &
+ &    '("but the provided variable can only hold ",I6)') var_sz
+    CALL ipslerr (3,'restget_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable ",A, &
+ &      //" requested from file is ",I6)') TRIM(vname_q),req_sz
+    WRITE(str2,'("but the provided variable can hold ",I6)') var_sz
+    CALL ipslerr (2,'restget_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+  CALL restget_real &
+    (fid,vname_q,iim,jjm,llm,itau,def_beha,buff_tmp1)
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        var(ji,jj,jk) = buff_tmp1(jl)
+      ENDDO
+    ENDDO
+  ENDDO
+!-------------------------
+END SUBROUTINE restget_r3d
+!===
+SUBROUTINE restget_real &
+  (fid,vname_q,iim,jjm,llm,itau,def_beha,var)
+!---------------------------------------------------------------------
+!- This subroutine is for getting a variable from the restart file.
+!- A number of verifications will be made :
+!- - Is this the first time we read this variable ?
+!- - Are the dimensions correct ?
+!- - Is the correct time step present in the file
+!- - is a default behaviour possible. If not the model is stoped.
+!- Default procedure is to write the content of val_exp on all values.
+!-
+!- INPUT
+!-
+!- fid            : Identification of the file
+!- vname_q        : Name of the variable to be read
+!- iim, jjm ,llm  : Dimensions of the variable that should be read
+!- itau           : Time step at whcih we are when we want
+!-                  to read the variable
+!- def_beha       : If the model can restart without this variable
+!-                  then some strange value is given.
+!-
+!- OUTPUT
+!-
+!- var            : Variable in which the data is put
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  LOGICAL :: def_beha
+  REAL :: var(:)
+!-
+  INTEGER :: vid,vnb,ncfid,iret,index,it,ndim,ia
+  CHARACTER(LEN=70) str,str2
+  CHARACTER(LEN=80) attname
+  INTEGER,DIMENSION(4) :: corner,edge
+!---------------------------------------------------------------------
+  ncfid = netcdf_id(fid,1)
+!-
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+! 1.0 If the variable is not present then ERROR or filled up
+!     by default values if allowed
+!-
+  IF (vnb < 0) THEN
+    IF (def_beha) THEN
+!-----
+      lock_valexp = .TRUE.
+      var(:) = val_exp
+!----
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (1,'restget', &
+ &      str,'but default values are used to fill in',' ')
+!----
+      IF (nbvar_in(fid) >= max_var) THEN
+        CALL ipslerr (3,'restget', &
+         'Too many variables for the restcom module', &
+         'Please increase the value of max_var',' ')
+      ENDIF
+      nbvar_in(fid) = nbvar_in(fid)+1
+      vnb = nbvar_in(fid)
+      varname_in(fid,vnb) = vname_q
+      touched_in(fid,vnb) = .TRUE.
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+!-----
+    ELSE
+      str = 'Variable '//TRIM(vname_q) &
+          //' is not present in the restart file'
+      CALL ipslerr (3,'restget', &
+ &      str,'but it is need to restart the model',' ')
+    ENDIF
+!---
+  ELSE
+!---
+!--  2.0 Check if the variable has not yet been read
+!--      and that the time is OK
+!---
+    vid = varid_in(fid,vnb)
+!---
+    nbvar_read(fid) = nbvar_read(fid)+1
+!---
+    IF (touched_in(fid,vnb)) THEN
+      str = 'Variable '//TRIM(vname_q) &
+          //' has already been read from file'
+      CALL ipslerr (3,'restget',str,' ',' ')
+    ENDIF
+!---
+!-- 3.0 get the time step of the restart file
+!--     and check if it is correct
+!---
+    index = -1
+    DO it=1,tax_size_in(fid)
+      IF (t_index(fid,it) == itau)  index = it
+    ENDDO
+    IF (index < 0) THEN
+      str = 'The time step requested for variable '//TRIM(vname_q)
+      CALL ipslerr (3,'restget', &
+ &      str,'is not available in the current file',' ')
+    ENDIF
+!---
+!-- 4.0 Read the data. Note that the variables in the restart files
+!--     have no time axis is and thus we write -1
+!---
+    str='Incorrect dimension for '//TRIM(vname_q)
+    ndim = 0
+    IF (iim > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == iim) THEN
+        corner(ndim) = 1
+        edge(ndim) = iim
+      ELSE
+        WRITE (str2,'("Incompatibility for iim : ",I6,I6)') &
+             iim,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (jjm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == jjm) THEN
+        corner(ndim) = 1
+        edge(ndim) = jjm
+      ELSE
+        WRITE (str2,'("Incompatibility for jjm : ",I6,I6)') &
+             jjm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+    IF (llm > 0) THEN
+      ndim = ndim+1
+      IF (vardims_in(fid,vnb,ndim) == llm) THEN
+        corner(ndim) = 1
+        edge(ndim) = llm
+      ELSE
+        WRITE (str2,'("Incompatibility for llm : ",I6,I6)') &
+             llm,vardims_in(fid,vnb,ndim)
+        CALL ipslerr (3,'restget',str,str2,' ')
+      ENDIF
+    ENDIF
+!---
+!-- Time
+!---
+    ndim = ndim+1
+    corner(ndim) = index
+!!????? edge(ndim) = index
+    edge(ndim) = 1
+!---
+    iret = NF90_GET_VAR(ncfid,vid,var, &
+ &                      start=corner(1:ndim),count=edge(1:ndim))
+!---
+!-- 5.0 The variable we have just read is created
+!--      in the next restart file
+!---
+    IF (     (netcdf_id(fid,1) /= netcdf_id(fid,2))  &
+ &      .AND.(netcdf_id(fid,2) > 0) ) THEN
+!-----
+      CALL restdefv (fid,vname_q,iim,jjm,llm,.FALSE.)
+!-----
+      DO ia = 1,varatt_in(fid,vnb)
+        iret = NF90_INQ_ATTNAME(ncfid,vid,ia,attname)
+        iret = NF90_COPY_ATT(ncfid,vid,attname, &
+ &               netcdf_id(fid,2),varid_out(fid,nbvar_out(fid)))
+      ENDDO
+!-----
+      IF (itau_out(fid) >= 0) THEN
+        iret = NF90_ENDDEF(netcdf_id(fid,2))
+      ENDIF
+    ENDIF
+!---
+  ENDIF
+!--------------------------
+END SUBROUTINE restget_real
+!===
+SUBROUTINE restput_opp_r1d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project a vector back onto the original 2D or 3D field.
+!- This requires that jjm and llm be equal to 1 or 0,
+!- else I would not know what it means.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: req_sz,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. jjm <= 1 .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+    IF (zax_infs(fid,1,1) > 0) req_sz = req_sz*zax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r1d')
+  CALL rest_alloc (2,req_sz,l_dbg,'restput_opp_r1d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    buff_tmp1(1:siz1) = var(:)
+    CALL mathop &
+ &    (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &     scal,req_sz,buff_tmp2)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r1d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  zax_infs(fid,1,1),itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r1d
+!===
+SUBROUTINE restput_opp_r2d &
+ & (fid,vname_q,iim,jjm,llm,itau,var,MY_OPERATOR,nbindex,ijndex)
+!---------------------------------------------------------------------
+!- This subroutine is the interface to restput_real which allows
+!- to re-index data onto the original grid of the restart file.
+!- The logic we use is still fuzzy in my mind but that is probably
+!- only because I have not yet though through everything.
+!-
+!- In the case iim = nbindex it means that the user attempts
+!- to project the first dimension of the matrix back onto a 3D field
+!- where jjm will be the third dimension.
+!- Here we do not allow for 4D data, thus we will take the first
+!- two dimensions in the file and require that llm = 1.
+!- These are pretty heavy constraints but I do not know how
+!- to make it more general. I need to think about it some more.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+  CHARACTER(LEN=*) :: MY_OPERATOR
+  INTEGER :: nbindex,ijndex(nbindex)
+!-
+  INTEGER :: jj,req_sz,ist,siz1
+  REAL :: scal
+  CHARACTER(LEN=7) :: topp
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 What size should be the data in the file
+!-
+  req_sz = 1
+  IF ( nbindex == iim .AND. llm <= 1) THEN
+    IF (xax_infs(fid,1,1) > 0) req_sz = req_sz*xax_infs(fid,1,1)
+    IF (yax_infs(fid,1,1) > 0) req_sz = req_sz*yax_infs(fid,1,1)
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Unable to performe an operation on this variable as it has', &
+      'a second and third dimension',vname_q)
+  ENDIF
+!-
+  IF (jjm < 1) THEN
+    CALL ipslerr (3,'restput_opp_r2d', &
+      'Please specify a second dimension which is the', &
+      'layer on which the operations are performed',vname_q)
+  ENDIF
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  CALL rest_alloc (1,siz1,l_dbg,'restput_opp_r2d')
+  CALL rest_alloc (2,req_sz*jjm,l_dbg,'restput_opp_r2d')
+!-
+! 2.0 We do the operation needed.
+!     It can only be a re-indexing operation.
+!     You would not want to change the values in a restart file or ?
+!-
+  topp = MY_OPERATOR(1:MIN(LEN_TRIM(MY_OPERATOR),7))
+!-
+  IF (INDEX(indchfun,topp(:LEN_TRIM(topp))) > 0) THEN
+    scal = missing_val
+    DO jj = 1,jjm
+      buff_tmp1(1:siz1) = var(:,jj)
+      ist = (jj-1)*req_sz+1
+      CALL mathop &
+ &      (topp,siz1,buff_tmp1,missing_val,nbindex,ijndex, &
+ &       scal,req_sz,buff_tmp2(ist:ist+req_sz-1))
+    ENDDO
+  ELSE
+    CALL ipslerr (3,'restput_opp_r2d', &
+ &    'The operation you wish to do on the variable for the ', &
+ &    'restart file is not allowed.',topp)
+  ENDIF
+!-
+  CALL restput_real &
+ & (fid,vname_q,xax_infs(fid,1,1),yax_infs(fid,1,1), &
+ &  jjm,itau,buff_tmp2)
+!-----------------------------
+END SUBROUTINE restput_opp_r2d
+!===
+SUBROUTINE restput_r1d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: ji,jl,req_sz,var_sz,siz1
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var)
+  var_sz = siz1
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r1d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size ",I6)') var_sz
+    CALL ipslerr (3,'restput_r1d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)') var_sz
+    CALL ipslerr (2,'restput_r1d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO ji=1,siz1
+    jl=jl+1
+    buff_tmp1(jl) = var(ji)
+  ENDDO
+!-
+  CALL restput_real (fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r1d
+!===
+SUBROUTINE restput_r2d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:)
+!-
+  INTEGER :: ji,jj,jl,req_sz,var_sz,siz1,siz2
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  var_sz = siz1*siz2
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r2d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+&         '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is of size  ",I6)') var_sz
+    CALL ipslerr (3,'restput_r2d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r2d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jj=1,siz2
+    DO ji=1,siz1
+      jl=jl+1
+      buff_tmp1(jl) = var(ji,jj)
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r2d
+!===
+SUBROUTINE restput_r3d (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine serves as an interface to restput_real
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: iim,jjm,llm,itau
+  REAL :: var(:,:,:)
+!-
+  INTEGER :: ji,jj,jk,jl,req_sz,var_sz,siz1,siz2,siz3
+  CHARACTER(LEN=70) :: str,str2
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 1.0 Allocate the temporary buffer we need
+!     to put the variable in right dimension
+!-
+  siz1 = SIZE(var,1)
+  siz2 = SIZE(var,2)
+  siz3 = SIZE(var,3)
+  var_sz = siz1*siz2*siz3
+  CALL rest_alloc (1,var_sz,l_dbg,'restput_r3d')
+!-
+! 2.0 Here we could check if the sizes specified agree
+!     with the size of the variable provided
+!-
+  req_sz = 1
+  IF (iim > 0) req_sz = req_sz*iim
+  IF (jjm > 0) req_sz = req_sz*jjm
+  IF (llm > 0) req_sz = req_sz*llm
+  IF (req_sz > var_sz) THEN
+    WRITE(str, &
+ &    '("Size of variable put to the file should be ",I6)') req_sz
+    WRITE(str2, &
+ &    '("but the provided variable is of size  ",I6)')  var_sz
+    CALL ipslerr (3,'restput_r3d',str,str2,' ')
+  ENDIF
+  IF (req_sz < var_sz) THEN
+    WRITE(str,'("the size of variable put to the file is ",I6)') req_sz
+    WRITE(str2,'("but the provided variable is larger ",I6)')  var_sz
+    CALL ipslerr (2,'restput_r3d', &
+      'There could be a problem here :',str,str2)
+  ENDIF
+!-
+! 4.0 Transfer the buffer obtained from the restart file
+!     into the variable the model expects
+!-
+  jl=0
+  DO jk=1,siz3
+    DO jj=1,siz2
+      DO ji=1,siz1
+        jl=jl+1
+        buff_tmp1(jl) = var(ji,jj,jk)
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+  CALL restput_real(fid,vname_q,iim,jjm,llm,itau,buff_tmp1)
+!-------------------------
+END SUBROUTINE restput_r3d
+!===
+SUBROUTINE restput_real (fid,vname_q,iim,jjm,llm,itau,var)
+!---------------------------------------------------------------------
+!- This subroutine will put a variable into the restart file.
+!- But it will do a lot of other things if needed :
+!- - Open a file if non is opened for this time-step
+!-   and all variables were written.
+!- - Add an axis if needed
+!- - verify that the variable has the right time step for this file
+!- - If it is time for a new file then it is opened
+!-   and the old one closed
+!- This requires that variables read from the last restart file were all
+!- written
+!-
+!- INPUT
+!-
+!- fid         : Id of the file in which we will write the variable
+!- vname_q     : Name of the variable to be written
+!- iim,jjm,llm : Size in 3D of the variable
+!- itau        : Time step at which the variable is written
+!- var         : Variable
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER :: fid,iim,jjm,llm,itau
+  REAL :: var(:)
+!-
+  INTEGER :: iret,vid,ncid,iv,vnb
+  INTEGER :: ierr
+  REAL :: secsince,one_day,one_year
+  INTEGER :: ndims
+  INTEGER,DIMENSION(4) :: corner,edge
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+! 0.0 Get some variables
+!-
+  ncid = netcdf_id(fid,2)
+  IF (netcdf_id(fid,2) < 0) THEN
+    CALL ipslerr (3,'restput', &
+ &    'The output restart file is undefined.',' ',' ')
+  ENDIF
+  CALL ioget_calendar (one_year,one_day)
+!-
+! 1.0 Check if the variable is already present
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 1.0 : ',TRIM(vname_q)
+!-
+  CALL find_str (varname_out(fid,1:nbvar_out(fid)),vname_q,vnb)
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'RESTPUT 1.1 : ',varname_out(fid,1:nbvar_out(fid)),vnb
+  ENDIF
+!-
+! 2.0 If variable is not present then declare it
+!     and add extra dimensions if needed.
+!-
+  IF (vnb <= 0) THEN
+    CALL restdefv (fid,vname_q,iim,jjm,llm,.TRUE.)
+    vnb = nbvar_out(fid)
+  ENDIF
+  vid = varid_out(fid,vnb)
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 2.0 : ',vnb,vid
+!-
+! 2.1 Is this file already in write mode ?
+!     If itau_out is still negative then we have
+!     never written to it and we need to go into write mode.
+!-
+  IF (itau_out(fid) < 0) THEN
+    iret = NF90_ENDDEF(ncid)
+  ENDIF
+!-
+! 3.0 Is this itau already on the axis ?
+!     If not then check that all variables of previous time is OK.
+!-
+  IF (l_dbg) WRITE(*,*) 'RESTPUT 3.0 : ',itau,itau_out(fid)
+!-
+  IF (itau /= itau_out(fid)) THEN
+!---
+!-- If it is the first time step written on the restart
+!-- then we only check the number
+!-- Else we see if every variable was written
+!---
+    IF (tstp_out(fid) == 0) THEN
+      IF (nbvar_out(fid) < nbvar_read(fid)) THEN
+        WRITE(*,*) "ERROR :",tstp_out(fid), &
+                   nbvar_out(fid),nbvar_read(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables read from the output file', &
+ &        'than written onto the input file.', &
+ &        'We trust you know what you are doing')
+      ENDIF
+    ELSE
+      ierr = 0
+      DO iv=1,nbvar_out(fid)
+        IF (.NOT.touched_out(fid,iv)) ierr = ierr+1
+      ENDDO
+      IF (ierr > 0) THEN
+        WRITE(*,*) "ERROR :",nbvar_out(fid)
+        CALL ipslerr (1,'restput', &
+ &        'There are fewer variables in the output file for this', &
+ &        'time step than for the previous one',' ')
+      ELSE
+        touched_out(fid,:) = .FALSE.
+      ENDIF
+    ENDIF
+!---
+    secsince = itau*deltat(fid)
+    corner(1) =  tstp_out(fid)+1
+    edge(1) = 1
+!---
+!-- 3.1 Here we add the values to the time axes
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) 'RESTPUT 3.1 : ',itau,secsince,corner(1),edge(1)
+    ENDIF
+!---
+    iret = NF90_PUT_VAR(ncid,tind_varid_out(fid),itau, &
+ &                      start=corner(1:1))
+    iret = NF90_PUT_VAR(ncid,tax_varid_out(fid),secsince, &
+ &                      start=corner(1:1))
+!---
+    tstp_out(fid) = tstp_out(fid)+1
+    itau_out(fid) = itau
+  ENDIF
+!-
+! 4.0 Variable and time step should be present
+!     now so we can dump variable
+!-
+  ndims = 0
+  IF (iim > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = iim
+  ENDIF
+  IF (jjm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = jjm
+  ENDIF
+  IF (llm > 0) THEN
+    ndims = ndims+1
+    corner(ndims) = 1
+    edge(ndims) = llm
+  ENDIF
+  ndims = ndims+1
+  corner(ndims) = tstp_out(fid)
+  edge(ndims) = 1
+!-
+  iret = NF90_PUT_VAR(ncid,vid,var, &
+ &                    start=corner(1:ndims),count=edge(1:ndims))
+!-
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (2,'restput_real',NF90_STRERROR(iret), &
+ &    'Bug in restput.',&
+ &    'Please, verify compatibility between get and put commands.')
+  ENDIF
+!-
+!  5.0 Note that the variables was treated
+!-
+  touched_out(fid,vnb) = .TRUE.
+!---------------------------
+END  SUBROUTINE restput_real
+!===
+SUBROUTINE restdefv (fid,varname,iim,jjm,llm,write_att)
+!---------------------------------------------------------------------
+! This subroutine adds a variable to the output file.
+! The attributes are either taken from.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER ::fid
+  CHARACTER(LEN=*) :: varname
+  INTEGER :: iim,jjm,llm
+  LOGICAL :: write_att
+!-
+  INTEGER :: dims(4),ic,xloc,ndim,ncfid
+  INTEGER :: iret,ax_id
+  CHARACTER(LEN=3) :: str
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  ncfid = netcdf_id(fid,2)
+  IF (nbvar_out(fid) >= max_var) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Too many variables for the restcom module', &
+      'Please increase the value of max_var',' ')
+  ENDIF
+  nbvar_out(fid) = nbvar_out(fid)+1
+  varname_out(fid,nbvar_out(fid)) = varname
+!-
+! 0.0 Put the file in define mode if needed
+!-
+  IF (itau_out(fid) >= 0) THEN
+    iret = NF90_REDEF(ncfid)
+  ENDIF
+!-
+! 1.0 Do we have all dimensions and can we go ahead
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 1.0 :',TRIM(varname),nbvar_out(fid)
+  ENDIF
+!-
+  ndim = 0
+!-
+! 1.1 Work on x
+!-
+  IF (iim > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,xax_nb(fid)
+      IF (xax_infs(fid,ic,1) == iim) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = xax_infs(fid,xloc,2)
+    ELSE
+      str='x_'//CHAR(96+xax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,iim,ax_id)
+      xax_nb(fid) = xax_nb(fid)+1
+      xax_infs(fid,xax_nb(fid),1) = iim
+      xax_infs(fid,xax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.2 Work on y
+!-
+  IF (jjm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,yax_nb(fid)
+      IF (yax_infs(fid,ic,1) == jjm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = yax_infs(fid,xloc,2)
+    ELSE
+      str='y_'//CHAR(96+yax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,jjm,ax_id)
+      yax_nb(fid) = yax_nb(fid)+1
+      yax_infs(fid,yax_nb(fid),1) = jjm
+      yax_infs(fid,yax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.3 Work on z
+!-
+  IF (llm > 0) THEN
+    ndim = ndim+1
+    xloc = 0
+    DO ic=1,zax_nb(fid)
+      IF (zax_infs(fid,ic,1) == llm) xloc = ic
+    ENDDO
+!---
+    IF (xloc > 0) THEN
+      dims(ndim) = zax_infs(fid,xloc,2)
+    ELSE
+      str='z_'//CHAR(96+zax_nb(fid))
+      iret = NF90_DEF_DIM(ncfid,str,llm,ax_id)
+      zax_nb(fid) = zax_nb(fid)+1
+      zax_infs(fid,zax_nb(fid),1) = llm
+      zax_infs(fid,zax_nb(fid),2) = ax_id
+      dims(ndim) = ax_id
+    ENDIF
+  ENDIF
+!-
+! 1.4  Time needs to be added
+!-
+  ndim = ndim+1
+  dims(ndim) = tdimid_out(fid)
+!-
+! 2.0  Declare the variable
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) 'restdefv 2.0 :',ndim,' :: ',dims(1:ndim),tdimid_out(fid)
+  ENDIF
+!-
+  iret = NF90_DEF_VAR(ncfid,varname,NF90_DOUBLE,dims(1:ndim), &
+ &                    varid_out(fid,nbvar_out(fid)))
+  IF (iret /= NF90_NOERR) THEN
+    CALL ipslerr (3,'restdefv', &
+      'Could not define new variable in file', &
+      NF90_STRERROR(iret),varname)
+  ENDIF
+!-
+! 3.0 Add the attributes if requested
+!-
+  IF (write_att) THEN
+    IF (rest_units /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'units',TRIM(rest_units))
+      rest_units = 'XXXXX'
+    ENDIF
+!---
+    IF (rest_lname /= 'XXXXX') THEN
+      iret =  NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                         'long_name',TRIM(rest_lname))
+      rest_lname = 'XXXXX'
+    ENDIF
+!---
+    iret = NF90_PUT_ATT(ncfid,varid_out(fid,nbvar_out(fid)), &
+ &                      'missing_value',REAL(missing_val,KIND=4))
+!---
+    IF (itau_out(fid) >= 0) THEN
+      iret = NF90_ENDDEF(ncfid)
+    ENDIF
+  ENDIF
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) &
+ &    'restdefv 3.0 : LIST OF VARS ',varname_out(fid,1:nbvar_out(fid))
+  ENDIF
+!----------------------
+END SUBROUTINE restdefv
+!===
+SUBROUTINE rest_atim (l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", [re]allocate the time axes
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_err,tszij
+  INTEGER,ALLOCATABLE :: tmp_index(:,:)
+  REAL,ALLOCATABLE :: tmp_julian(:,:)
+!---------------------------------------------------------------------
+!-
+!  Allocate the space we need for the time axes
+!-
+  IF (.NOT.ALLOCATED(t_index) .AND. .NOT.ALLOCATED(t_julian)) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Allocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE(t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of t_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_index (:,:) = 0
+!---
+    ALLOCATE(t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of max_file,tax_size_in','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian (:,:) = 0.0
+  ELSE IF (    (SIZE(t_index,DIM=2)  < tax_size_in(nb_fi)) &
+ &         .OR.(SIZE(t_julian,DIM=2) < tax_size_in(nb_fi)) ) THEN
+    IF (l_msg) THEN
+      WRITE(*,*) TRIM(c_p)//' : Reallocate times axes at :', &
+ &               max_file,tax_size_in(nb_fi)
+    ENDIF
+!---
+    ALLOCATE (tmp_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of tmp_index','', &
+ &      '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_index,DIM=2)
+    tmp_index(:,1:tszij) = t_index(:,1:tszij)
+    DEALLOCATE(t_index)
+    ALLOCATE (t_index(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_index : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in reallocation of t_index','', &
+ &     '(you must increase memory)')
+    ENDIF
+    t_index(:,1:tszij) = tmp_index(:,1:tszij)
+!---
+    ALLOCATE (tmp_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of tmp_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &     'Problem in allocation of tmp_julian','', &
+ &     '(you must increase memory)')
+    ENDIF
+    tszij = SIZE(t_julian,DIM=2)
+    tmp_julian(:,1:tszij) = t_julian(:,1:tszij)
+    DEALLOCATE(t_julian)
+    ALLOCATE (t_julian(max_file,tax_size_in(nb_fi)),STAT=i_err)
+    IF (i_err/=0) THEN
+      WRITE(*,*) "ERROR IN ALLOCATION of t_julian : ",i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in reallocation of t_julian','', &
+ &      '(you must increase memory)')
+    ENDIF
+    t_julian(:,1:tszij) = tmp_julian(:,1:tszij)
+  ENDIF
+!-----------------------
+END SUBROUTINE rest_atim
+!===
+SUBROUTINE rest_alloc (i_buff,i_qsz,l_msg,c_p)
+!---------------------------------------------------------------------
+! Called by "c_p", allocate a temporary buffer
+! (buff_tmp[1/2] depending on "i_buff" value) to the size "i_qsz".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_buff,i_qsz
+  LOGICAL,INTENT(IN) :: l_msg
+  CHARACTER(LEN=*),INTENT(IN) :: c_p
+!-
+  INTEGER :: i_bsz,i_err
+  LOGICAL :: l_alloc1,l_alloc2
+  CHARACTER(LEN=9) :: cbn
+  CHARACTER(LEN=5) :: c_err
+!---------------------------------------------------------------------
+  IF      (i_buff == 1) THEN
+    IF (ALLOCATED(buff_tmp1)) THEN
+      i_bsz = SIZE(buff_tmp1)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 =    (.NOT.ALLOCATED(buff_tmp1)) &
+ &            .OR.((ALLOCATED(buff_tmp1)).AND.(i_qsz > i_bsz))
+    l_alloc2 = .FALSE.
+    cbn = 'buff_tmp1'
+  ELSE IF (i_buff == 2) THEN
+    IF (ALLOCATED(buff_tmp2)) THEN
+      i_bsz = SIZE(buff_tmp2)
+    ELSE
+      i_bsz = 0
+    ENDIF
+    l_alloc1 = .FALSE.
+    l_alloc2 =    (.NOT.ALLOCATED(buff_tmp2)) &
+ &            .OR.((ALLOCATED(buff_tmp2)).AND.(i_qsz > i_bsz))
+    cbn = 'buff_tmp2'
+  ELSE
+    CALL ipslerr (3,'rest_alloc', &
+ &    'Called by '//TRIM(c_p),'with a wrong value of i_buff','')
+  ENDIF
+!-
+!-
+  IF (l_alloc1.OR.l_alloc2) THEN
+    IF (l_msg) THEN
+      IF (    (l_alloc1.AND.ALLOCATED(buff_tmp1)) &
+ &        .OR.(l_alloc2.AND.ALLOCATED(buff_tmp2)) ) THEN
+        WRITE(*,*) TRIM(c_p)//" : re_allocate "//TRIM(cbn)//"=",i_qsz
+      ELSE
+        WRITE(*,*) TRIM(c_p)//" : allocate "//TRIM(cbn)//"=",i_qsz
+      ENDIF
+    ENDIF
+    IF (l_alloc1) THEN
+      IF (ALLOCATED(buff_tmp1)) THEN
+        DEALLOCATE(buff_tmp1)
+      ENDIF
+      ALLOCATE (buff_tmp1(i_qsz),STAT=i_err)
+    ELSE
+      IF (ALLOCATED(buff_tmp2)) THEN
+        DEALLOCATE(buff_tmp2)
+      ENDIF
+      ALLOCATE (buff_tmp2(i_qsz),STAT=i_err)
+    ENDIF
+    IF (i_err /= 0) THEN
+      WRITE (UNIT=c_err,FMT='(I5)') i_err
+      CALL ipslerr (3,TRIM(c_p), &
+ &      'Problem in allocation of',TRIM(cbn), &
+ &      'Error : '//TRIM(c_err)//' (you must increase memory)')
+    ENDIF
+  ENDIF
+!------------------------
+END SUBROUTINE rest_alloc
+!===
+SUBROUTINE ioconf_setatt (attname,value)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: attname,value
+!-
+  CHARACTER(LEN=LEN_TRIM(attname)) :: tmp_str
+!---------------------------------------------------------------------
+  tmp_str = attname
+  CALL strlowercase (tmp_str)
+!-
+  SELECT CASE(tmp_str)
+    CASE('units')
+      rest_units = value
+    CASE('long_name')
+      rest_lname = value
+    CASE DEFAULT
+      CALL ipslerr (2,'ioconf_restatt', &
+        'The attribute name provided is unknown',attname,' ')
+  END SELECT
+!---------------------------
+END SUBROUTINE ioconf_setatt
+!===
+SUBROUTINE ioget_vdim (fid,vname_q,varnbdim_max,varnbdim,vardims)
+!---------------------------------------------------------------------
+!- This routine allows the user to get the dimensions
+!- of a field in the restart file.
+!- This is the file which is read.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  CHARACTER(LEN=*) :: vname_q
+  INTEGER,INTENT(IN) :: varnbdim_max
+  INTEGER,INTENT(OUT) ::  varnbdim
+  INTEGER,DIMENSION(varnbdim_max),INTENT(OUT) :: vardims
+!-
+  INTEGER :: vnb
+!---------------------------------------------------------------------
+! Find the index of the variable
+  CALL find_str (varname_in(fid,1:nbvar_in(fid)),vname_q,vnb)
+!-
+  IF (vnb > 0) THEN
+    varnbdim = varnbdim_in(fid,vnb)
+    IF (varnbdim_max < varnbdim) THEN
+      CALL ipslerr (3,'ioget_vdim', &
+        'The provided array for the variable dimensions is too small', &
+        '','')
+    ELSE
+      vardims(1:varnbdim) = vardims_in(fid,vnb,1:varnbdim)
+    ENDIF
+  ELSE
+    varnbdim = 0
+    CALL ipslerr (2,'ioget_vdim', &
+      'Variable '//TRIM(vname_q)//' not found','','')
+  ENDIF
+!------------------------
+END SUBROUTINE ioget_vdim
+!===
+SUBROUTINE ioget_vname (fid,nbvar,varnames)
+!---------------------------------------------------------------------
+!- This routine allows the user to extract the list
+!- of variables in an opened restart file.
+!- This is the file which is read
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: fid
+  INTEGER,INTENT(OUT) ::  nbvar
+  CHARACTER(LEN=*),INTENT(OUT) :: varnames(:)
+!---------------------------------------------------------------------
+  nbvar = nbvar_in(fid)
+!-
+  IF (SIZE(varnames) < nbvar) THEN
+    CALL ipslerr (3,'ioget_vname', &
+      'The provided array for the variable names is too small','','')
+  ELSE
+    varnames(1:nbvar) = varname_in(fid,1:nbvar)
+  ENDIF
+!-------------------------
+END SUBROUTINE ioget_vname
+!===
+SUBROUTINE ioconf_expval (new_exp_val)
+!---------------------------------------------------------------------
+!- The default value written into the variables which are not
+!- in the restart file can only be changed once.
+!- This avoids further complications.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: new_exp_val
+!---------------------------------------------------------------------
+  IF (.NOT.lock_valexp) THEN
+    lock_valexp = .TRUE.
+    val_exp = new_exp_val
+  ELSE
+    CALL ipslerr (2,'ioconf_expval', &
+     'The default value for variable' &
+   //'not available in the restart file ', &
+     'has already been locked and can not be changed at this point', &
+     ' ')
+  ENDIF
+!---------------------------
+END SUBROUTINE ioconf_expval
+!===
+SUBROUTINE ioget_expval (get_exp_val)
+!---------------------------------------------------------------------
+!- Once the user has extracted the default value,
+!- we lock it so that it can not be changed anymore.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  REAL :: get_exp_val
+!---------------------------------------------------------------------
+  get_exp_val = val_exp
+  lock_valexp = .TRUE.
+!--------------------------
+END SUBROUTINE ioget_expval
+!===
+SUBROUTINE restclo (fid)
+!---------------------------------------------------------------------
+!- This subroutine closes one or any opened restart file.
+!-
+!- INPUT
+!-
+!- fid    : File ID in the restcom system (not the netCDF ID)(optional)
+!-
+!- OUTPUT
+!-
+!- NONE
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(in),OPTIONAL :: fid
+!-
+  INTEGER :: iret,ifnc
+  CHARACTER(LEN=6) :: n_e
+  CHARACTER(LEN=3) :: n_f
+  LOGICAL :: l_dbg
+!---------------------------------------------------------------------
+  CALL ipsldbg (old_status=l_dbg)
+!-
+  IF (PRESENT(fid)) THEN
+!---
+    IF (l_dbg) THEN
+      WRITE(*,*) &
+        'restclo : Closing specified restart file number :', &
+        fid,netcdf_id(fid,1:2)
+    ENDIF
+!---
+    IF (netcdf_id(fid,1) > 0) THEN
+      iret = NF90_CLOSE(netcdf_id(fid,1))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,1)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      IF (netcdf_id(fid,1) == netcdf_id(fid,2)) THEN
+        netcdf_id(fid,2) = -1
+      ENDIF
+      netcdf_id(fid,1) = -1
+    ENDIF
+!---
+    IF (netcdf_id(fid,2) > 0)  THEN
+      iret = NF90_CLOSE(netcdf_id(fid,2))
+      IF (iret /= NF90_NOERR) THEN
+        WRITE (n_e,'(I6)') iret
+        WRITE (n_f,'(I3)') netcdf_id(fid,2)
+        CALL ipslerr (2,'restclo', &
+          "Error "//n_e//" in closing file : "//n_f,'',' ')
+      ENDIF
+      netcdf_id(fid,2) = -1
+    ENDIF
+!---
+  ELSE
+!---
+    IF (l_dbg) WRITE(*,*) 'restclo : Closing all files'
+!---
+    DO ifnc=1,nb_fi
+      IF (netcdf_id(ifnc,1) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,1))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,1)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        ENDIF
+        IF (netcdf_id(ifnc,1) == netcdf_id(ifnc,2)) THEN
+          netcdf_id(ifnc,2) = -1
+        ENDIF
+        netcdf_id(ifnc,1) = -1
+      ENDIF
+!-----
+      IF (netcdf_id(ifnc,2) > 0) THEN
+        iret = NF90_CLOSE(netcdf_id(ifnc,2))
+        IF (iret /= NF90_NOERR) THEN
+          WRITE (n_e,'(I6)') iret
+          WRITE (n_f,'(I3)') netcdf_id(ifnc,2)
+          CALL ipslerr (2,'restclo', &
+            "Error "//n_e//" in closing file : "//n_f,'',' ')
+        END IF
+        netcdf_id(ifnc,2) = -1
+      ENDIF
+    ENDDO
+  ENDIF
+!---------------------
+END SUBROUTINE restclo
+!===
+!-----------------
+END MODULE restcom
Index: vendors/IOIPSL/src/stringop.f90
===================================================================
--- vendors/IOIPSL/src/stringop.f90	(revision 9621)
+++ vendors/IOIPSL/src/stringop.f90	(revision 9621)
@@ -0,0 +1,185 @@
+MODULE stringop
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+CONTAINS
+!=
+SUBROUTINE cmpblank (str)
+!---------------------------------------------------------------------
+!- Compact blanks
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(inout) :: str
+!-
+  INTEGER :: lcc,ipb
+!---------------------------------------------------------------------
+  lcc = LEN_TRIM(str)
+  ipb = 1
+  DO
+    IF (ipb >= lcc)   EXIT
+    IF (str(ipb:ipb+1) == '  ') THEN
+      str(ipb+1:) = str(ipb+2:lcc)
+      lcc = lcc-1
+    ELSE
+      ipb = ipb+1
+    ENDIF
+  ENDDO
+!----------------------
+END SUBROUTINE cmpblank
+!===
+INTEGER FUNCTION cntpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds number of occurences of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!-
+  INTEGER :: ipos,indx
+!---------------------------------------------------------------------
+  cntpos = 0
+  ipos   = 1
+  DO
+    indx = INDEX(c_c(ipos:l_c),c_r(1:l_r))
+    IF (indx > 0) THEN
+      cntpos = cntpos+1
+      ipos   = ipos+indx+l_r-1
+    ELSE
+      EXIT
+    ENDIF
+  ENDDO
+!------------------
+END FUNCTION cntpos
+!===
+INTEGER FUNCTION findpos (c_c,l_c,c_r,l_r)
+!---------------------------------------------------------------------
+!- Finds position of c_r in c_c
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(in) :: c_c
+  INTEGER,INTENT(IN) :: l_c
+  CHARACTER(LEN=*),INTENT(in) :: c_r
+  INTEGER,INTENT(IN) :: l_r
+!---------------------------------------------------------------------
+  findpos = INDEX(c_c(1:l_c),c_r(1:l_r))
+  IF (findpos == 0)  findpos=-1
+!-------------------
+END FUNCTION findpos
+!===
+SUBROUTINE find_str (str_tab,str,pos)
+!---------------------------------------------------------------------
+!- This subroutine looks for a string in a table
+!---------------------------------------------------------------------
+!- INPUT
+!-   str_tab  : Table  of strings
+!-   str      : Target we are looking for
+!- OUTPUT
+!-   pos      : -1 if str not found, else value in the table
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(in) :: str_tab
+  CHARACTER(LEN=*),INTENT(in) :: str
+  INTEGER,INTENT(out) :: pos
+!-
+  INTEGER :: nb_str,i
+!---------------------------------------------------------------------
+  pos = -1
+  nb_str=SIZE(str_tab)
+  IF ( nb_str > 0 ) THEN
+    DO i=1,nb_str
+      IF ( TRIM(str_tab(i)) == TRIM(str) ) THEN
+        pos = i
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!----------------------
+END SUBROUTINE find_str
+!===
+SUBROUTINE nocomma (str)
+!---------------------------------------------------------------------
+!- Replace commas with blanks
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    IF (str(i:i) == ',')   str(i:i) = ' '
+  ENDDO
+!---------------------
+END SUBROUTINE nocomma
+!===
+SUBROUTINE strlowercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into lowercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 65).AND.(ic <= 90) )  str(i:i) = ACHAR(ic+32)
+  ENDDO
+!--------------------------
+END SUBROUTINE strlowercase
+!===
+SUBROUTINE struppercase (str)
+!---------------------------------------------------------------------
+!- Converts a string into uppercase
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: str
+!-
+  INTEGER :: i,ic
+!---------------------------------------------------------------------
+  DO i=1,LEN_TRIM(str)
+    ic = IACHAR(str(i:i))
+    IF ( (ic >= 97).AND.(ic <= 122) )  str(i:i) = ACHAR(ic-32)
+  ENDDO
+!--------------------------
+END SUBROUTINE struppercase
+!===
+SUBROUTINE str_xfw (c_string,c_word,l_ok)
+!---------------------------------------------------------------------
+!- Given a character string "c_string", of arbitrary length,
+!- returns a logical flag "l_ok" if a word is found in it,
+!- the first word "c_word" if found and the new string "c_string"
+!- without the first word "c_word"
+!---------------------------------------------------------------------
+  CHARACTER(LEN=*),INTENT(INOUT) :: c_string
+  CHARACTER(LEN=*),INTENT(OUT) :: c_word
+  LOGICAL,INTENT(OUT) :: l_ok
+!-
+  INTEGER :: i_b,i_e
+!---------------------------------------------------------------------
+  l_ok = (LEN_TRIM(c_string) > 0)
+  IF (l_ok) THEN
+    i_b = VERIFY(c_string,' ')
+    i_e = INDEX(c_string(i_b:),' ')
+    IF (i_e == 0) THEN
+      c_word = c_string(i_b:)
+      c_string = ""
+    ELSE
+      c_word = c_string(i_b:i_b+i_e-2)
+      c_string = ADJUSTL(c_string(i_b+i_e-1:))
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE str_xfw
+!===
+!------------------
+END MODULE stringop
Index: vendors/IOIPSL/tools/Fparser.f90
===================================================================
--- vendors/IOIPSL/tools/Fparser.f90	(revision 9621)
+++ vendors/IOIPSL/tools/Fparser.f90	(revision 9621)
@@ -0,0 +1,793 @@
+PROGRAM fparser
+!-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+
+  USE stringop
+
+  IMPLICIT NONE
+  !
+  !
+  !     Parses the code to create the Config.in Config.default and Config.help
+  !     which are used by the tk shell.
+  !
+  !
+  INTEGER nbkeymax, nbhelpmax, nbcasemax, nbsourmax, nbelmax
+  PARAMETER (nbkeymax=100, nbhelpmax=50, nbcasemax=50, nbsourmax=20,nbelmax=nbhelpmax+10)
+  INTEGER nbfilesmax
+  PARAMETER (nbfilesmax=150)
+
+  !
+  CHARACTER*120 :: configs(nbkeymax,nbelmax)
+  CHARACTER*120 :: tmp_help, tmp_key, tmp_desc, tmp_def
+  INTEGER :: keylen(nbkeymax), nbkeys
+  INTEGER :: key_pos(nbkeymax), help_pos(nbkeymax,2), def_pos(nbkeymax,2)
+  INTEGER :: des_pos(nbkeymax), IF_pos(nbkeymax)
+  CHARACTER*6 TYPE_op(nbkeymax)
+  !
+  CHARACTER*120 :: def_out(nbkeymax, nbhelpmax)
+  INTEGER :: nbdef_out(nbkeymax)
+  !
+  CHARACTER*120 :: tke
+  !
+  CHARACTER*2 :: nbstr
+  !
+  CHARACTER*80 :: files(nbfilesmax), source(nbsourmax), filetmp
+  CHARACTER*80 :: tmp, main_name
+  CHARACTER*120 :: keycase(nbcasemax), tmp_CASE
+  INTEGER :: nbcase, ii, find, nbsource
+  LOGICAL :: next_source, next_name, last_or
+
+  LOGICAL :: is_main, cont
+
+  CHARACTER*1 :: backslash, simplequote, doublequote
+
+  INTEGER :: ia, iread, iret, IFF, ih, nb_line, iv, id
+  INTEGER :: ind_space, ind_comma, ind_USE
+  INTEGER :: nbfiles, nb_key, nb_key_file
+  !
+  INTEGER, EXTERNAL ::  iargc, getarg 
+  !
+  !
+  next_source = .FALSE.
+  next_name = .FALSE.
+  is_main = .FALSE.
+  nbsource = 0
+  nbfiles = 0
+  main_name = 'IPSL'
+  !
+  backslash = ACHAR(92)
+  simplequote = ACHAR(39)
+  doublequote = ACHAR(34)
+  !
+  !
+  !
+  !     Analyse command line
+  !
+  !
+  !     Get the number of arguments, that is the options and the
+  !     files to be parsed.
+  !
+  !
+
+  iread = iargc()
+  !
+  DO ia=1,iread
+     !
+     iret = getarg(ia,tmp)
+     !
+     IF (next_source) THEN
+
+        nbsource = nbsource + 1
+        IF ( nbsource .GT. nbsourmax) THEN
+           WRITE(*,*) 'Too many files to source in the arguments.' 
+           WRITE(*,*) 'Increase nbsourmax'
+           STOP
+        ELSE
+           source(nbsource) = tmp(1:LEN_TRIM(tmp))
+        ENDIF
+        next_source = .FALSE.
+
+     ELSE IF (next_name) THEN
+        main_name = tmp(1:LEN_TRIM(tmp))
+        next_name = .FALSE.
+
+     ELSE
+        !     
+        IF ( INDEX(tmp,'-m') .GT. 0) THEN
+           is_main = .TRUE.
+        ELSE IF ( INDEX(tmp,'-n') .GT. 0) THEN
+           next_name = .TRUE.
+        ELSE IF ( INDEX(tmp,'-s') .GT. 0) THEN
+           next_source = .TRUE.
+        ELSE IF ( INDEX(tmp,'-h') .GT. 0) THEN
+           WRITE(*,*) 'USAGE : Fparse [-name NAME] '
+           WRITE(*,*) '               [-source file_to_source]'
+           WRITE(*,*) '               [-main] FORTAN_files'
+        ELSE
+           nbfiles = nbfiles + 1
+           IF ( nbfiles .GT. nbfilesmax) THEN
+              WRITE(*,*) 'Too many files to include in &
+                   &                 the arguments.' 
+              WRITE(*,*) 'Increase nbfilesmax'
+              STOP
+           ELSE
+              files(nbfiles) = tmp(1:LEN_TRIM(tmp))
+           ENDIF
+        ENDIF
+
+     ENDIF
+
+  ENDDO
+  !
+  IF ( nbfiles .LT. 1 ) THEN
+     WRITE(*,*) 'No files provided'
+     STOP
+  ENDIF
+  !
+  !
+  !     1.0 Read files and extract the lines which we need
+  !
+  !
+  nb_key = 0
+  !
+  DO IFF=1,nbfiles
+     !
+     filetmp = files(IFF)
+     CALL READ_from_file(filetmp, nbkeymax, nbelmax, configs, nb_key, keylen)
+     !
+  ENDDO
+  !
+  !     2.0 Scan the information we have extracted from the file for the elements we need
+  !
+  !
+  CALL analyse_configs(nbkeymax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
+  !
+  !
+  !  3.0 Prepare the default values to put them in an array
+  !
+  !
+  DO ia = 1,nb_key
+     !
+     !  3.1 Go to blank delimited lines
+     !
+     nbdef_out(ia) = 0
+     !
+     DO ii=def_pos(ia,1), def_pos(ia,2)
+        !
+        tmp_help = configs(ia,ii)
+        ind_comma = INDEX(tmp_help(1:len_TRIM(tmp_help)),',')
+        DO WHILE (ind_comma .GT. 0) 
+           tmp_help(ind_comma:ind_comma) = ' '
+           ind_comma = INDEX(tmp_help,',')
+        ENDDO
+        CALL cmpblank(tmp_help)
+        configs(ia,ii) = tmp_help
+        !
+        !  3.2 extract the values
+        !
+        tmp_help = TRIM(ADJUSTL(configs(ia,ii)))
+        ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
+        ! Get the first one (there is no space in between)
+        IF ( ind_space .EQ. 0) THEN
+           nbdef_out(ia) = nbdef_out(ia) + 1
+           def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
+        ELSE
+           ! Get all those which are before spaces
+           DO WHILE (ind_space .GT. 0) 
+              nbdef_out(ia) = nbdef_out(ia) + 1
+              def_out(ia, nbdef_out(ia)) = tmp_help(1:ind_space)
+              tmp_help = ADJUSTL(tmp_help(ind_space+1:LEN_TRIM(tmp_help)))
+              ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
+           ENDDO
+           !    Get the last one which does not have a space behind
+           IF ( LEN_TRIM(tmp_help) .GT. 0) THEN
+              nbdef_out(ia) = nbdef_out(ia) + 1
+              def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
+           ENDIF
+           !
+        ENDIF
+     ENDDO
+     !
+  ENDDO
+  !
+  !
+  !
+  !      4.0 OPEN Config.in Defaults and Help files
+  !
+  !
+  OPEN (16, FILE='Config.in')
+  OPEN (17, FILE='Config.help')
+  OPEN (18, FILE='Config.defaults')
+  !
+  !     Some explantation
+  !
+  DO IFF=16,18
+     WRITE(IFF,'(1a)') '# '
+     WRITE(IFF,'(1a)') '# File created by Fparser, DO NOT EDIT'
+     WRITE(IFF,'(2a)') '# ', main_name(1:LEN_TRIM(main_name))
+     WRITE(IFF,'(1a)') '# '
+     WRITE(IFF,'(1a)') '# '
+  ENDDO
+  !
+  WRITE(17,'(2a)') '# Format of this file: description<nl>', &
+       &     ' variable<nl>helptext<nl><nl>.'
+  WRITE(17,'(2a)') '# If the question being documented is of', &
+       &     ' type "choice", we list'
+  WRITE(17,'(2a)') '# only the first occurring config variable.', &
+       &     ' The help texts'
+  WRITE(17,'(2a)') '# must not contain empty lines. No variable', &
+       &     ' should occur twice; if it'
+  WRITE(17,'(2a)') '# does, only the first occurrence will be', &
+       &     ' used by Configure. The lines'
+  WRITE(17,'(2a)') '# in a help text should be indented two', &
+       &     ' positions. Lines starting with'
+  WRITE(17,'(2a)') '# "#" are ignored. To be nice to menuconfig,', &
+       &     ' limit your lines to 70'
+  WRITE(17,'(2a)') '# characters. Use emacs" kfill.el to edit', &
+       &     ' this file or you lose.'
+  WRITE(17,'(2a)') '#'
+  !
+  IF ( is_main ) THEN
+     WRITE(16,'(3a)') 'mainmenu_name "Configuration of model ', &
+          &        main_name(1:LEN_TRIM(main_name)), '"'
+     WRITE(16,'(1a)') '# '
+  ENDIF
+  !
+  WRITE(16,'(1a)') 'mainmenu_option next_comment'
+  WRITE(16,'(3a)') 'comment "', main_name(1:LEN_TRIM(main_name)), '"'
+  WRITE(16,'(1a)') '# '
+  !
+  !   5.0 Loop through the KEYWORDS to prepare the output
+  !
+  DO IFF =1,nb_key
+     !
+     !     Config.in file
+     !
+
+     !
+     !     Is it a conditional option ?
+     !
+     IF ( IF_pos(IFF) .GE. 0)  THEN
+        tmp_help = configs(IFF,IF_pos(IFF))
+        !
+        IF ( (index(tmp_help,'||') .LE. 0) .AND. (index(tmp_help,'&&') .LE. 0) ) THEN
+           IF ( tmp_help(1:1) .EQ. '!') THEN
+              WRITE(16,'(3a)') 'if [ "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+           ELSE
+              WRITE(16,'(3a)') 'if [ "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+           ENDIF
+        ELSE
+           !
+           last_or = .TRUE.
+           nbcase = 0
+           !
+           DO WHILE( INDEX(tmp_help,'||') .GT. 0)
+              ii = INDEX(tmp_help,'||')
+              nbcase = nbcase + 1
+              if ( nbcase .EQ. 1 ) THEN
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ELSE
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') '-o "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') '-o "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ENDIF
+              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
+           ENDDO
+           !
+           DO WHILE( INDEX(tmp_help,'&&') .GT. 0)
+              ii = INDEX(tmp_help,'&&')
+              nbcase = nbcase + 1
+              if ( nbcase .EQ. 1 ) THEN
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ELSE
+                 IF ( tmp_help(1:1) .EQ. '!') THEN
+                    WRITE(16,'(3a)') '-a "$', tmp_help(2:ii-1),  '" = "n" \\'
+                 ELSE
+                    WRITE(16,'(3a)') '-a "$', tmp_help(1:ii-1),  '" = "y" \\'
+                 ENDIF
+              ENDIF
+              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
+              last_or = .FALSE.
+           ENDDO
+           !
+           IF ( last_or ) THEN
+              IF ( tmp_help(1:1) .EQ. '!') THEN
+                 WRITE(16,'(3a)') '-o "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+              ELSE
+                 WRITE(16,'(3a)') '-o "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+              ENDIF
+           ELSE
+              IF ( tmp_help(1:1) .EQ. '!') THEN
+                 WRITE(16,'(3a)') '-a "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
+              ELSE
+                 WRITE(16,'(3a)') '-a "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
+              ENDIF
+           ENDIF
+        ENDIF
+        WRITE(16,'(1a)') '       '
+     ENDIF
+     !
+     !      Extract the information from configs
+     !
+     DO iv = 1,nbdef_out(IFF)
+
+        IF (nbdef_out(IFF) .EQ. 1) THEN
+           tmp_key = configs(IFF,key_pos(IFF))
+           tmp_desc = configs(IFF,des_pos(IFF))
+           tmp_def = def_out(IFF,iv)
+        ELSE
+           tmp_key = configs(IFF,key_pos(IFF))
+           WRITE(nbstr,'(I2.2)') iv
+           tmp_key = tmp_key(1:LEN_TRIM(tmp_key))//'__'//nbstr
+           tmp_desc = configs(IFF,des_pos(IFF))
+           IF ( iv .EQ. 1) THEN
+              tmp_desc = tmp_desc(1:LEN_TRIM(tmp_desc))//' (Vector)'
+           ELSE
+              tmp_desc = 'Cont...    '//tmp_key(1:LEN_TRIM(tmp_key))
+           ENDIF
+           tmp_def = def_out(IFF,iv)
+        ENDIF
+        !
+        !
+        !
+        IF (INDEX(TYPE_op(IFF),'bool') .GT. 0) THEN
+           !
+           WRITE(16,'(4a)') 'bool "', tmp_desc(1:LEN_TRIM(tmp_desc)), &
+                &              '" ',tmp_key(1:LEN_TRIM(tmp_key))
+           !
+        ELSE IF (INDEX(TYPE_op(IFF),'hex') .GT. 0) THEN
+           !
+           WRITE(16,'(6a)') 'hex "', tmp_desc(1:LEN_TRIM(tmp_desc)) &
+                &              ,'" ',tmp_key(1:LEN_TRIM(tmp_key)) &
+                &              ,' ',tmp_def(1:LEN_TRIM(tmp_def))
+           !
+        ELSE IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+           !
+           !   Get number of options
+           !
+           nbcase = 0
+           DO WHILE( INDEX(tmp_key,'||') .GT. 0)
+              ii = INDEX(tmp_key,'||')
+              nbcase = nbcase + 1
+              keycase(nbcase) = tmp_key(1:ii-1)
+              tmp_key=tmp_key(ii+2:LEN_TRIM(tmp_key))
+           ENDDO
+           nbcase = nbcase + 1
+           keycase(nbcase) = tmp_key(1:LEN_TRIM(tmp_key))
+
+           WRITE(16,'(4a)') "choice '", tmp_desc(1:LEN_TRIM(tmp_desc))," '",backslash
+           !
+           !   List options
+           !
+           tmp_CASE = keycase(1)
+           WRITE(16,'(5a)') '        "', tmp_CASE(1:LEN_TRIM(tmp_CASE)), "          "&
+                &,tmp_CASE(1:LEN_TRIM(tmp_CASE)), backslash
+           !
+           DO ii=2,nbcase-1
+              tmp_CASE = keycase(ii)
+              WRITE(16,'(5a)') '         ',   tmp_CASE(1:LEN_TRIM(tmp_CASE)),  '          ',&
+                   & tmp_CASE(1:LEN_TRIM(tmp_CASE)),  backslash
+           ENDDO
+           !
+           tmp_CASE = keycase(nbcase)
+           WRITE(16,'(6a)') '         ', &
+                &              tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
+                &              '          ', tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
+                &              '"  ',tmp_def(1:LEN_TRIM(tmp_def)) 
+           !
+        ELSE
+           WRITE(*,'(2a)') 'Uniplemented operation : ', TYPE_op(IFF)
+           STOP
+        ENDIF
+        !
+        !     Config.help file
+        !
+        tmp_key = configs(IFF,key_pos(IFF))
+        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+           ii = INDEX(tmp_key,'||')-1
+        ELSE
+           ii = LEN_TRIM(tmp_key)
+        ENDIF
+
+        IF ( nbdef_out(IFF) .GT. 1) THEN
+           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
+           WRITE(nbstr,'(I2.2)') iv
+           tke = tmp_key(1:ii)//'__'//nbstr
+           WRITE(17,'(1a)') tke(1:LEN_TRIM(tke))
+           WRITE(17,'(1a)') '  (Vector)'
+        ELSE
+           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
+           WRITE(17,'(1a)') tmp_key(1:ii)
+        ENDIF
+        !
+        DO ih=help_pos(IFF,1),help_pos(IFF,2)
+           tmp_help = configs(IFF,ih)
+           WRITE(17,'("  ",1a)') tmp_help(1:LEN_TRIM(tmp_help))
+        ENDDO
+        !
+        !     Config.default file
+        !
+        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
+
+           WRITE(18,'(2a)') tmp_def(1:LEN_TRIM(tmp_def)),'=y'
+
+        ELSE
+
+           WRITE(18,'(3a)') tmp_key(1:LEN_TRIM(tmp_key)),'=', &
+                &              tmp_def(1:LEN_TRIM(tmp_def))
+
+        ENDIF
+        !     
+        !     Add some empty line to all files
+        !     
+        WRITE(16,'(1a)') '       '
+        WRITE(17,'(1a)') '       '
+        WRITE(17,'(1a)') '       '
+     ENDDO
+     !
+     !
+     !     Close the IF if needed
+     !
+
+     IF ( IF_pos(IFF) .GT. 0) THEN
+        WRITE(16,'(1a)') 'fi'
+        WRITE(16,'(1a)') '       '
+     ENDIF
+
+     !
+  ENDDO
+  !
+  WRITE(16,'(1a)') 'endmenu'
+  WRITE(16,'(1a)') '       '
+  IF ( nbsource .GT. 0) THEN
+     DO ih=1,nbsource
+        tmp = source(ih)
+        WRITE(16,'(1a)') '              '
+        WRITE(16,'(3a)') 'source ',tmp(1:LEN_TRIM(tmp)), &
+             &           '/Config.in'
+     ENDDO
+  ENDIF
+  !
+  !
+  CLOSE(16)
+  CLOSE(17)
+  CLOSE(18)
+  !
+  !
+  !
+  STOP
+
+END PROGRAM fparser
+!
+!
+!==========================================================
+!
+!
+SUBROUTINE READ_from_file(file, nbkeymax, nbelmax, configs, nbitems, itemlen)
+  !
+  USE stringop
+  !
+  IMPLICIT NONE
+  !
+  !
+  !     This routine reads the file and adds the config info it finds to the configs array.
+  !     Thus the nbitems is an imput variable as it can be increased as we go through the files.
+  !
+  !
+  CHARACTER*(*) :: file
+  INTEGER :: nbkeymax, nbelmax
+  CHARACTER*120 :: configs(nbkeymax, nbelmax)
+  INTEGER ::  nbitems, itemlen(nbkeymax)
+  !
+  INTEGER :: conf_pos, ip
+  CHARACTER*250 line
+  LOGICAL :: cont, conf_END
+  !
+  cont = .TRUE.
+  conf_END = .TRUE.
+  !
+  OPEN (12, file=file)
+  !
+  !   1.0 Loop over all the lines of a given file to extract all the configuration line
+  !
+  DO WHILE (cont)
+    READ(12,'(a)',END=9999) line
+    !
+    !   1.0  A configuration line is detected by the line below.
+    !
+    IF ( INDEX(line,'Config') .EQ. 1 .OR. INDEX(line,'!'//'Config') .GE. 1 ) THEN
+        !
+        IF ( conf_END ) THEN
+            nbitems = nbitems + 1
+            IF ( nbitems .GT. nbkeymax) THEN
+                WRITE(*,*) 'read_from_file : The number of keys in the input array is too small for this file'
+                STOP
+            ENDIF
+            itemlen(nbitems) = 0
+            conf_END = .FALSE.
+        ENDIF
+        !
+        itemlen(nbitems) = itemlen(nbitems) + 1
+        IF ( itemlen(nbitems) .GT. nbelmax ) THEN
+            WRITE(*,*) 'read_from_file : The number of elements per key in the input array is too small'
+            STOP
+        ENDIF
+        !
+        !  The detected line is shaved !
+        !
+        IF ( INDEX(line,'Config') .EQ. 1) THEN
+            conf_pos = 7
+        ELSE
+            conf_pos = INDEX(line,'!'//'Config') +7
+        ENDIF
+        line = line(conf_pos:LEN_TRIM(line))
+        line = TRIM(ADJUSTL(line))
+        CALL cmpblank(line)
+        !
+        configs(nbitems,itemlen(nbitems)) = line
+        !
+    ELSE
+        !
+        !   Look for the end of a configuration structure.
+        !  It is determined by a call to the getin subroutine
+        !
+        CALL strlowercase(line)
+        CALL cmpblank(line)
+        ip = INDEX(line,' (')
+        DO WHILE (ip .GT. 0)
+          line = line(1:ip-1)//line(ip+1:LEN_TRIM(line))
+          ip = INDEX(line,' (')
+        ENDDO
+        IF ( INDEX(line, 'call getin(') .GT. 0 .OR. INDEX(line, 'call setvar(') .GT. 0) THEN
+            conf_END = .TRUE.
+        ENDIF
+        !
+    ENDIF
+    !
+    cont = .TRUE.
+    GOTO 8888
+9999 cont = .FALSE.
+8888 CONTINUE
+    
+    ENDDO
+  !
+  CLOSE(12)
+  !
+  END SUBROUTINE READ_from_file
+  !
+  !==========================================================
+  !
+  !
+  SUBROUTINE analyse_configs(nbkmax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
+    !
+  USE stringop
+  !
+    IMPLICIT NONE
+    !
+    !
+    !    This subroutine will localize the KEYWORDS in the configs array
+    !    and extract all their arguments. For the moment 5 arguments are recognized :
+    !    KEY  : The keyword by which the all is identified
+    !    HELP : This identifies the help text
+    !    DEF : The default value of for this KEYWORD
+    !    DESC : A short description, not more than one line
+    !    IF : Specifies the other Keyword it depend on. This is a nice features for the menus as it can hide 
+    !            things we do not need
+    !
+    !    The DEF and HELP keywords can be multi line
+    !
+    INTEGER :: nbkmax, nb_key, nbelmax
+    INTEGER :: keylen(nbkmax)
+    INTEGER :: key_pos(nbkmax), help_pos(nbkmax,2), def_pos(nbkmax,2), des_pos(nbkmax), IF_pos(nbkmax)
+    CHARACTER*120 :: configs(nbkmax,nbelmax)
+    CHARACTER*6 :: TYPE_op(nbkmax)
+    !
+    !   This is the number of arguments we need to find an end for and the total number of arguments  we can have.
+    !   Thus these parameters needs to be updated when the list of arguments to the routine is changed
+    !
+    INTEGER, PARAMETER :: toendlen=2, indexlen=5
+    !
+    INTEGER :: toend(toendlen), foundend(toendlen), kindex(indexlen)
+    INTEGER :: ik, il, ieq
+    CHARACTER*120 :: tmp_str, tmp_str2
+    !
+    !
+    key_pos(1:nb_key)=-1
+    help_pos(1:nb_key,1:2)=-1
+    def_pos(1:nb_key,1:2)=-1
+    des_pos(1:nb_key)=-1
+    IF_pos(1:nb_key)=-1
+    TYPE_op(1:nb_key)='hex'
+    !
+    DO ik=1,nb_key
+      !
+      !
+      DO il=1,keylen(ik)
+        !
+        ieq = INDEX(configs(ik,il),'=')
+        tmp_str = configs(ik,il)
+        tmp_str = tmp_str(1:ieq)
+        CALL struppercase(tmp_str)
+        !
+        !      Decide if this is a reserved name and where it fits
+        !
+        !      At the same time we clean up the configs array
+        !
+        IF ( INDEX(tmp_str,'KEY') .GT. 0) THEN
+            IF ( key_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a KEYWORD, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            key_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+            !
+            !   Here we have to check that we are not in an 'choice' case
+            !
+            IF ( INDEX(tmp_str2,'||') .GT. 0) THEN
+                TYPE_op(ik) = 'choice'
+            ENDIF
+            !
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'DEF') .GT. 0) THEN
+            IF ( def_pos(ik,1) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a DEF, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            def_pos(ik,1) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            tmp_str2 = TRIM(ADJUSTL(tmp_str2))
+            configs(ik,il) = tmp_str2 
+            !
+            !  Here we can check if we have a boolean operation
+            !  We also wish to standardise the value of booleans
+            !
+            CALL struppercase(tmp_str2)
+            IF (INDEX(tmp_str2,'Y') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'T') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'YES') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 3 .OR.&
+               & INDEX(tmp_str2,'TRUE') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 4 .OR.&
+               & INDEX(tmp_str2,'.TRUE.') .EQ. 1) THEN
+                configs(ik,il) = 'y'
+                TYPE_op(ik) = 'bool'
+            ENDIF
+            !
+            IF (INDEX(tmp_str2,'N') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'F') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
+               & INDEX(tmp_str2,'NO') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 2 .OR.&
+               & INDEX(tmp_str2,'FALSE') .EQ. 1  .AND. LEN_TRIM(tmp_str2) .EQ. 5 .OR.&
+               & INDEX(tmp_str2,'.FALSE.') .EQ. 1) THEN
+                configs(ik,il) = 'n'
+                TYPE_op(ik) = 'bool'
+            ENDIF
+            !
+            ! Here we check if we have a default behavior and put a standard name
+            !
+            IF (INDEX(tmp_str2,'DEF') .EQ. 1 .OR. INDEX(tmp_str2,'NONE') .EQ. 1) THEN
+                configs(ik,il) = 'default'
+            ENDIF
+            !
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'DESC') .GT. 0) THEN
+            IF ( des_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a DESC, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            des_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF
+        !
+        IF ( INDEX(tmp_str,'IF') .GT. 0) THEN
+            IF ( IF_pos(ik) .GT. 0) THEN
+                WRITE(*,*) 'analyse_config : Already have a IF, check that you have a call to getin'
+                WRITE(*,*) 'analyse_config : ', configs(ik,il)
+                STOP
+            ENDIF
+            IF_pos(ik) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF 
+        !
+        IF ( INDEX(tmp_str,'HELP') .GT. 0) THEN
+            help_pos(ik,1) = il
+            tmp_str2 = configs(ik,il)
+            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
+            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
+        ENDIF
+        !
+      ENDDO
+      !
+      !     Check if we not missing some important informations as for instance
+      !
+      !     THE KEYWORD 
+      !
+      IF ( key_pos(ik) .LT. 1) THEN
+          WRITE(*,*) 'analyse_configs : Could not find a keyword in the following entry :'
+          DO il=1,keylen(ik)
+            WRITE(*,'(a70)') configs(ik,il)
+          ENDDO
+          STOP
+      ENDIF
+      !
+      !      THE DEFAULT VALUE
+      !
+      IF ( def_pos(ik,1) .LT. 1) THEN
+          WRITE(*,*) 'analyse_configs : Could not find a default value in the following entry :'
+          DO il=1,keylen(ik)
+            WRITE(*,'(a70)') configs(ik,il)
+          ENDDO
+          STOP
+      ENDIF
+      !
+      !   Get the end of all the multi line arguments
+      !
+      toend(1) = MAX(def_pos(ik,1),1)
+      toend(2) = MAX(help_pos(ik,1),1)
+      foundend(:) = keylen(ik)
+      kindex(1) = MAX(key_pos(ik),1)
+      kindex(2) = MAX(des_pos(ik),1)
+      kindex(3) = MAX(def_pos(ik,1),1)
+      kindex(4) = MAX(IF_pos(ik),1)
+      kindex(5) = MAX(help_pos(ik,1),1)
+      CALL find_ends(toendlen, toend, indexlen, kindex, foundend)
+      def_pos(ik,2) = foundend(1)
+      help_pos(ik,2) = foundend(2)
+      !
+    ENDDO
+    !
+  END SUBROUTINE analyse_configs
+  !
+  SUBROUTINE find_ends(toendlen, toend, indexlen, kindex, foundend)
+    !
+    IMPLICIT NONE
+    !
+    !
+    !  We find the end of the text for all the elements in the key which are multi line
+    !   This subroutine aims at providing a flexible way to determine this so that other
+    !   elements in the Keyword can be multi line. For the moment it is only the Help and Ded 
+    !  which are allowed to be multi line.
+    !
+    !  Foundend need to be initialized to the maximum value of the elements
+    !
+    !
+    INTEGER :: toendlen, toend(toendlen), indexlen, kindex(indexlen), foundend(toendlen)
+    !
+    INTEGER :: whmin(1), ie, ii
+    !
+    DO ie=1,toendlen
+      !
+      whmin = MINLOC(toend(1:toendlen))
+      !
+      DO ii=1,indexlen
+        IF ( kindex(ii) .GT. toend(whmin(1)) .AND. foundend(whmin(1)) .GE. kindex(ii)) THEN
+            foundend(whmin(1)) = kindex(ii)-1
+            toend(whmin(1)) = 100000
+        ENDIF
+      ENDDO
+      !
+    ENDDO
+    !
+  END SUBROUTINE find_ends
Index: vendors/IOIPSL/tools/flio_rbld.f90
===================================================================
--- vendors/IOIPSL/tools/flio_rbld.f90	(revision 9621)
+++ vendors/IOIPSL/tools/flio_rbld.f90	(revision 9621)
@@ -0,0 +1,1784 @@
+PROGRAM flio_rbld
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!!--------------------------------------------------------------------
+!! PROGRAM flio_rbld
+!!
+!! PURPOSE :
+!!   Recombine the files of MPI version of IOIPSL
+!!   along several dimensions.
+!!
+!! CALLING SEQUENCE :
+!!
+!!   "flio_rbld" is usually invoked by the script "rebuild"
+!!
+!!   rebuild -h
+!!
+!!   rebuild [-v lev] [-f] -o outfile infile[1] ... infile[n]
+!!
+!! INPUT for "rebuild" :
+!!
+!!   -h         : help
+!!   -v lev     : verbosity level
+!!   -f         : force executing mode
+!!   -o outfile : name of the recombined file.
+!!   infiles    : names of the files that must be recombined.
+!!
+!! INPUT for "flio_rbld" :
+!!
+!!  (I) i_v_lev  : verbosity level
+!!  (C) c_force  : executing mode (noforce/force)
+!!  (I) f_nb     : total number of files
+!!  (C) f_nm(:)  : names of the files (input_files output_file)
+!!
+!!
+!! ASSOCIATED MODULES :
+!!   IOIPSL(fliocom)
+!!
+!! RESTRICTIONS :
+!!
+!!   Cases for character are not coded.
+!!
+!!   Cases for netCDF variables such as array with more
+!!   than 5 dimensions are not coded.
+!!
+!!   Input files must have the following global attributes :
+!!
+!!     "DOMAIN_number_total"
+!!     "DOMAIN_number"
+!!     "DOMAIN_dimensions_ids"
+!!     "DOMAIN_size_global"
+!!     "DOMAIN_size_local"
+!!     "DOMAIN_position_first"
+!!     "DOMAIN_position_last"
+!!     "DOMAIN_halo_size_start"
+!!     "DOMAIN_halo_size_end"
+!!     "DOMAIN_type"
+!!
+!!   NetCDF files must be smaller than 2 Gb.
+!!
+!!   Character variables should have less than 257 letters
+!!
+!! EXAMPLE :
+!!
+!!   rebuild -v -o sst.nc sst_[0-9][0-9][0-9][0-9].nc
+!!
+!! MODIFICATION HISTORY :
+!!   Sebastien Masson   (smasson@jamstec.go.jp)   March 2004
+!!   Jacques   Bellier  (Jacques.Bellier@cea.fr)  June  2005
+!!--------------------------------------------------------------------
+  USE IOIPSL
+  USE defprec
+!-
+  IMPLICIT NONE
+!-
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+!-
+! DO loops and test related variables
+  INTEGER :: i,ia,id,iv,iw,i_i,i_n
+  INTEGER :: ik,itmin,itmax,it1,it2,it
+  LOGICAL :: l_force,l_uld
+!-
+! Input arguments related variables
+  INTEGER :: i_v_lev
+  CHARACTER(LEN=15) :: c_force
+  INTEGER :: f_nb,f_nb_in
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm
+!-
+! Domains related variables
+  INTEGER :: d_n_t,i_ntd
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dom_att,d_d_i,d_s_g
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: d_s_l,d_p_f,d_p_l,d_h_s,d_h_e
+  LOGICAL :: l_cgd,l_cof,l_col,l_o_f,l_o_m,l_o_l
+  CHARACTER(LEN=chlen) :: c_d_n
+!-
+! Model files related variables
+  LOGICAL :: l_ocf
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id
+  INTEGER :: f_id_i1,f_id_i,f_id_o
+  INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_d_ul
+  INTEGER :: v_a_nb,a_type
+  CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: &
+&  f_d_nm,f_v_nm,f_a_nm,v_a_nm
+  CHARACTER(LEN=chlen) :: f_u_nm
+  INTEGER,DIMENSION(:),ALLOCATABLE :: v_d_nb,v_d_ul,v_type
+  INTEGER,DIMENSION(:,:),ALLOCATABLE :: v_d_i
+  INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l
+  INTEGER :: a_l
+  INTEGER,DIMENSION(flio_max_var_dims) :: d_i,ib,ie
+  INTEGER,DIMENSION(:),ALLOCATABLE :: &
+ &  io_i,io_n,ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl
+  LOGICAL :: l_ex
+  CHARACTER(LEN=chlen) :: c_wn1,c_wn2
+!-
+!?INTEGERS of KIND 1 are not supported on all computers
+!?INTEGER(KIND=i_1) :: i1_0d
+!?INTEGER(KIND=i_1),DIMENSION(:),ALLOCATABLE :: i1_1d
+!?INTEGER(KIND=i_1),DIMENSION(:,:),ALLOCATABLE :: i1_2d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:),ALLOCATABLE :: i1_3d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),ALLOCATABLE :: i1_4d
+!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i1_5d
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2),DIMENSION(:),ALLOCATABLE :: i2_1d
+  INTEGER(KIND=i_2),DIMENSION(:,:),ALLOCATABLE :: i2_2d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:),ALLOCATABLE :: i2_3d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:),ALLOCATABLE :: i2_4d
+  INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i2_5d
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4),DIMENSION(:),ALLOCATABLE :: i4_1d
+  INTEGER(KIND=i_4),DIMENSION(:,:),ALLOCATABLE :: i4_2d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:),ALLOCATABLE :: i4_3d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:),ALLOCATABLE :: i4_4d
+  INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i4_5d
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4),DIMENSION(:),ALLOCATABLE :: r4_1d
+  REAL(KIND=r_4),DIMENSION(:,:),ALLOCATABLE :: r4_2d
+  REAL(KIND=r_4),DIMENSION(:,:,:),ALLOCATABLE :: r4_3d
+  REAL(KIND=r_4),DIMENSION(:,:,:,:),ALLOCATABLE :: r4_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r4_5d
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8),DIMENSION(:),ALLOCATABLE :: r8_1d
+  REAL(KIND=r_8),DIMENSION(:,:),ALLOCATABLE :: r8_2d
+  REAL(KIND=r_8),DIMENSION(:,:,:),ALLOCATABLE :: r8_3d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:),ALLOCATABLE :: r8_4d
+  REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r8_5d
+!-
+! elapsed and cpu time computation variables
+  INTEGER :: nb_cc_ini,nb_cc_end,nb_cc_sec,nb_cc_max
+  REAL :: t_cpu_ini,t_cpu_end
+!---------------------------------------------------------------------
+!-
+!-------------------
+! INPUT arguments
+!-------------------
+!-
+! Retrieve the verbosity level
+  READ (UNIT=*,FMT=*) i_v_lev
+!-
+! Retrieve the executing mode
+  READ (UNIT=*,FMT='(A)') c_force
+  l_force = (TRIM(c_force)  == 'force')
+!-
+! Retrieve the number of arguments
+  READ (UNIT=*,FMT=*) f_nb
+  f_nb_in = f_nb-1
+!-
+! Retrieve the file names
+  ALLOCATE(f_nm(f_nb))
+  DO iw=1,f_nb
+    READ (UNIT=*,FMT='(A)') f_nm(iw)
+  ENDDO
+!-
+! Allocate and initialize the array of file access identifiers
+  ALLOCATE(f_a_id(f_nb_in)); f_a_id(:) = -1;
+!-
+  IF (i_v_lev >= 1) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,FMT='(" verbosity level : ",I4)') i_v_lev
+    WRITE (UNIT=*,FMT='(" executing  mode : ",A)') TRIM(c_force)
+    WRITE (UNIT=*,FMT='(" number of args  : ",I4)') f_nb
+    WRITE (UNIT=*,FMT='(" Input  files :")')
+    DO iw=1,f_nb_in
+      WRITE (*,'("   ",A)') TRIM(f_nm(iw))
+    ENDDO
+    WRITE (UNIT=*,FMT='(" Output file  :")')
+    WRITE (*,'("   ",A)') TRIM(f_nm(f_nb))
+!-- time initializations
+    CALL system_clock &
+ &   (count=nb_cc_ini,count_rate=nb_cc_sec,count_max=nb_cc_max)
+    CALL cpu_time (t_cpu_ini)
+  ENDIF
+!-
+!---------------------------------------------------
+! Retrieve basic informations from the first file
+!---------------------------------------------------
+!-
+! Open the first file
+  CALL flrb_of (1,f_id_i)
+!-
+! Get the attribute "DOMAIN_number_total"
+  CALL fliogeta (f_id_i,"?","DOMAIN_number_total",d_n_t)
+!-
+! Validate the number of input files :
+! should be equal to the total number
+! of domains used in the simulation
+  IF (d_n_t /= f_nb_in) THEN
+    IF (l_force) THEN
+      iw = 2
+    ELSE
+      iw = 3
+      DEALLOCATE(f_nm,f_a_id)
+      CALL flrb_cf (1,.TRUE.)
+    ENDIF
+    CALL ipslerr (iw,"flio_rbld", &
+ &   "The number of input files", &
+ &   "is not equal to the number of DOMAINS"," ")
+  ENDIF
+!-
+! Retrieve the basic characteristics of the first input file
+  CALL flioinqf &
+ & (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_d_ul)
+!-
+! Build the list of the names of the
+! dimensions/variables/global_attributes and retrieve
+! the unlimited_dimension name from the first input file
+  ALLOCATE(f_d_nm(f_d_nb),f_v_nm(f_v_nb),f_a_nm(f_a_nb))
+  CALL flioinqn (f_id_i,cn_dim=f_d_nm,cn_var=f_v_nm, &
+ &                      cn_gat=f_a_nm,cn_uld=f_u_nm)
+!-
+! Build the list of the dimensions identifiers and lengths
+  ALLOCATE(f_d_i(f_d_nb),f_d_l(f_d_nb))
+  CALL flioinqf (f_id_i,id_dim=f_d_i,ln_dim=f_d_l)
+!-
+! Close the file
+  CALL flrb_cf (1,.FALSE.)
+!-
+! Check if the number of needed files is greater than
+! the maximum number of simultaneously opened files.
+! In that case, open and close model files for each reading,
+! otherwise keep the "flio" identifiers of the opened files.
+  l_ocf = (f_nb > flio_max_files)
+!-
+!----------------------------------------------------
+! Retrieve domain informations for each input file
+!----------------------------------------------------
+!-
+  DO iw=1,f_nb_in
+!---
+    CALL flrb_of (iw,f_id_i)
+!---
+    IF (iw > 1) THEN
+      c_wn1 = "DOMAIN_number_total"
+      CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+      IF (l_ex) THEN
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),i_ntd)
+        IF (i_ntd /= d_n_t) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &        "File      : "//TRIM(f_nm(iw)), &
+ &        "Attribute : "//TRIM(c_wn1), &
+ &        "not equal to the one of the first file")
+        ENDIF
+      ELSE
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1),"not found")
+      ENDIF
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_dimensions_ids"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      ALLOCATE(dom_att(a_l))
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+      IF (iw == 1) THEN
+        IF (ANY(dom_att(:) == f_d_ul)) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "contains the unlimited dimension")
+        ENDIF
+        ALLOCATE (d_d_i(a_l))
+        d_d_i(:) = dom_att(:)
+      ELSEIF (SIZE(dom_att) /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ELSEIF (ANY(dom_att(:) /= d_d_i(:))) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+      DEALLOCATE(dom_att)
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_global"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_g(a_l))
+          d_s_g(:)=dom_att(:)
+        ELSEIF (ANY(dom_att(:) /= d_s_g(:))) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "not equal to the one of the first file")
+        ENDIF
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_size_local"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_s_l(a_l,f_nb_in))
+        ENDIF
+        d_s_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_first"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_f(a_l,f_nb_in))
+        ENDIF
+        d_p_f(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_position_last"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_p_l(a_l,f_nb_in))
+        ENDIF
+        d_p_l(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_start"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_s(a_l,f_nb_in))
+        ENDIF
+        d_h_s(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_halo_size_end"
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      IF (a_l /= SIZE(d_d_i)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "size of the attribute : "//TRIM(c_wn1), &
+ &       "not equal to the size of DOMAIN_dimensions_ids")
+      ELSE
+        ALLOCATE(dom_att(a_l))
+        CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
+        IF (iw == 1) THEN
+          ALLOCATE (d_h_e(a_l,f_nb_in))
+        ENDIF
+        d_h_e(:,iw)=dom_att(:)
+        DEALLOCATE(dom_att)
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    c_wn1 = "DOMAIN_type"
+    c_wn2 = " "
+    CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
+    IF (l_ex) THEN
+      CALL fliogeta (f_id_i,"?",TRIM(c_wn1),c_wn2)
+      CALL strlowercase (c_wn2)
+      IF (iw == 1) THEN
+        IF (    (TRIM(c_wn2) == "box") &
+ &          .OR.(TRIM(c_wn2) == "apple") ) THEN
+          c_d_n = c_wn2
+        ELSE
+          CALL ipslerr (3,"flio_rbld", &
+ &         "File      : "//TRIM(f_nm(iw)), &
+ &         "Attribute : "//TRIM(c_wn1), &
+ &         "type "//TRIM(c_wn2)//" not (yet) supported")
+        ENDIF
+      ELSEIF (TRIM(c_wn2) /= TRIM(c_d_n)) THEN
+        CALL ipslerr (3,"flio_rbld", &
+ &       "File      : "//TRIM(f_nm(iw)), &
+ &       "Attribute : "//TRIM(c_wn1), &
+ &       "not equal to the one of the first file")
+      ENDIF
+    ELSE
+      CALL ipslerr (3,"flio_rbld", &
+ &     "File      : "//TRIM(f_nm(iw)), &
+ &     "Attribute : "//TRIM(c_wn1),"not found")
+    ENDIF
+!---
+    CALL flrb_cf (iw,l_ocf)
+!---
+  ENDDO
+!-
+  IF (i_v_lev >= 2) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From the first file : ")')
+    WRITE (*,'("   Number of dimensions : ",I2)') f_d_nb
+    WRITE (*,'("     Idents  : ",(10(1X,I4),:))') f_d_i(1:f_d_nb)
+    WRITE (*,'("     Lengths : ",(10(1X,I4),:))') f_d_l(1:f_d_nb)
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_d_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_d_nm(i))
+    ENDDO
+    IF (f_d_ul > 0) THEN
+      WRITE (*,'("   Unlimited dimension id : ",I2)') f_d_i(f_d_ul)
+    ENDIF
+    WRITE (*,'("   Number of variables  : ",I2)') f_v_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_v_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_v_nm(i))
+    ENDDO
+    WRITE (*,'("   Number of global attributes : ",I2)') f_a_nb
+    WRITE (*,'("     Names: ")')
+    DO i=1,f_a_nb
+      WRITE (*,'("       """,A,"""")') TRIM(f_a_nm(i))
+    ENDDO
+  ENDIF
+  IF (i_v_lev >= 3) THEN
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (*,'(" From input files : ")')
+    WRITE (*,'("   Total number of DOMAINS : ",I4)') d_n_t
+    WRITE (*,'("   DOMAIN_dimensions_ids :",(10(1X,I5),:))') d_d_i(:)
+    WRITE (*,'("   DOMAIN_size_global    :",(10(1X,I5),:))') d_s_g(:)
+    WRITE (*,'("   DOMAIN_type           : """,(A),"""")') TRIM(c_d_n)
+    DO iw=1,f_nb_in
+      WRITE (*,'("   File   : ",A)') TRIM(f_nm(iw))
+      WRITE (*,'("     d_s_l  :",(10(1X,I5),:))') d_s_l(:,iw)
+      WRITE (*,'("     d_p_f  :",(10(1X,I5),:))') d_p_f(:,iw)
+      WRITE (*,'("     d_p_l  :",(10(1X,I5),:))') d_p_l(:,iw)
+      WRITE (*,'("     d_h_s  :",(10(1X,I5),:))') d_h_s(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_s(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Beginning offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+      WRITE (*,'("     d_h_e  :",(10(1X,I5),:))') d_h_e(:,iw)
+      IF (TRIM(c_d_n) == "apple") THEN
+        IF (COUNT(d_h_e(:,iw) /= 0) > 1) THEN
+          CALL ipslerr (3,"flio_rbld", &
+ &          "Ending offset is not yet supported", &
+ &          "for more than one dimension"," ")
+        ENDIF
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+!---------------------------------------
+! Create the dimensionned output file
+!---------------------------------------
+!-
+! Define the dimensions used in the output file
+  DO id=1,f_d_nb
+    DO i=1,SIZE(d_d_i)
+      IF (f_d_i(id) == d_d_i(i)) THEN
+        f_d_l(id) = d_s_g(i)
+      ENDIF
+    ENDDO
+  ENDDO
+!-
+  IF (f_d_ul > 0) THEN
+    i = f_d_l(f_d_ul); f_d_l(f_d_ul) = -1;
+  ENDIF
+!-
+! Create the output file
+  CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1)
+!-
+  IF (f_d_ul > 0) THEN
+    f_d_l(f_d_ul) = i; itmin = 1; itmax = f_d_l(f_d_ul);
+  ELSE
+    itmin = 1; itmax = 1;
+  ENDIF
+!-
+! open the first input file used to build the output file
+!-
+  CALL flrb_of (1,f_id_i1)
+!-
+! define the global attributes in the output file
+! copy all global attributes except those beginning by "DOMAIN_"
+! eventually actualize the "file_name" attribute
+!-
+  DO ia=1,f_a_nb
+    IF (INDEX(TRIM(f_a_nm(ia)),"DOMAIN_") == 1)  CYCLE
+    IF (TRIM(f_a_nm(ia)) == "file_name") THEN
+      CALL flioputa (f_id_o,"?",TRIM(f_a_nm(ia)),TRIM(c_wn1))
+    ELSE
+      CALL fliocpya (f_id_i1,"?",TRIM(f_a_nm(ia)),f_id_o,"?")
+    ENDIF
+  ENDDO
+!-
+! define the variables in the output file
+!-
+  ALLOCATE(v_d_nb(f_v_nb)); v_d_nb(:) = 0;
+  ALLOCATE(v_d_ul(f_v_nb)); v_d_ul(:) = 0;
+  ALLOCATE(v_type(f_v_nb),v_d_i(flio_max_var_dims,f_v_nb));
+  DO iv=1,f_v_nb
+!-- get variable informations
+    CALL flioinqv &
+ &   (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type(iv), &
+ &    nb_dims=v_d_nb(iv),id_dims=d_i,nb_atts=v_a_nb)
+!-- define the new variable
+    IF (v_d_nb(iv) == 0) THEN
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type(iv))
+    ELSE
+      CALL fliodefv &
+ &     (f_id_o,TRIM(f_v_nm(iv)),d_i(1:v_d_nb(iv)),v_t=v_type(iv))
+      DO iw=1,v_d_nb(iv)
+        IF (f_d_ul > 0) THEN
+          IF (d_i(iw) == f_d_ul) THEN
+            v_d_ul(iv) = iw
+          ENDIF
+        ENDIF
+      ENDDO
+      v_d_i(1:v_d_nb(iv),iv) = d_i(1:v_d_nb(iv))
+    ENDIF
+!-- copy all variable attributes
+    IF (v_a_nb > 0) THEN
+      ALLOCATE(v_a_nm(v_a_nb))
+      CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
+      DO ia=1,v_a_nb
+        CALL fliocpya &
+ &       (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
+ &        f_id_o,TRIM(f_v_nm(iv)))
+      ENDDO
+      DEALLOCATE(v_a_nm)
+    ENDIF
+  ENDDO
+!-
+! update valid_min valid_max attributes values
+!-
+  CALL flrb_rg
+!-
+!------------------------
+! Fill the output file
+!------------------------
+!-
+  DO ik=1,2
+    l_uld = (ik /= 1)
+    IF (l_uld) THEN
+      it1=itmin; it2=itmax;
+    ELSE
+      it1=1; it2=1;
+    ENDIF
+    DO it=it1,it2
+      DO iv=1,f_v_nb
+        IF (    (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) &
+ &          .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN
+          CYCLE
+        ENDIF
+        IF (i_v_lev >= 3) THEN
+          WRITE (UNIT=*,FMT='("")')
+          IF (l_uld) THEN
+            WRITE (UNIT=*,FMT=*) "time step     : ",it
+          ENDIF
+          WRITE (UNIT=*,FMT=*) "variable      : ",TRIM(f_v_nm(iv))
+          WRITE (UNIT=*,FMT=*) "var unlim dim : ",v_d_ul(iv)
+        ENDIF
+!------ do the variable contains dimensions to be recombined ?
+        l_cgd = .FALSE.
+        i_n = 1
+        DO i=1,SIZE(d_d_i)
+          l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i))
+          l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i))
+          IF (l_cgd) THEN
+            i_n = f_nb_in
+              EXIT
+          ENDIF
+        ENDDO
+        IF (v_d_nb(iv) > 0) THEN
+!-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm
+          i = v_d_nb(iv)
+          ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i))
+!-------- Default definition of io_i,io_n,io_sm,io_cm
+          io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv));
+          ia_sm(:) = 1; io_sm(:) = 1;
+          IF (v_d_ul(iv) > 0) THEN
+            io_i(v_d_ul(iv))=it
+            io_n(v_d_ul(iv))=1
+            io_sm(v_d_ul(iv))=it
+          ENDIF
+          io_cm(:) = io_n(:);
+!-------- If needed, allocate offset
+          l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+          IF (TRIM(c_d_n) == "apple") THEN
+            ALLOCATE(ia_sf(i),io_sf(i),io_cf(i))
+            ALLOCATE(ia_sl(i),io_sl(i),io_cl(i))
+            ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
+            ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
+            IF (v_d_ul(iv) > 0) THEN
+              io_sf(v_d_ul(iv))=it
+              io_sl(v_d_ul(iv))=it
+            ENDIF
+          ENDIF
+!-------- Initialize to zero variables data 
+          ! approximate dimension
+          IF ( it == 1 .AND. l_cgd) THEN
+          ! Enter I*J I*J is larger thant total number of single files
+            if ( ((f_d_l(1)/(d_s_l(1,1)-3)) * (f_d_l(2)/(d_s_l(2,1)-3) )) .gt. d_n_t ) then 
+              CALL ZeroFill (f_id_o, f_v_nm(iv), f_d_l, v_d_nb(iv), v_type(iv), v_d_i(1:v_d_nb(iv),iv))
+            endif
+          ENDIF
+        ENDIF
+!------
+        DO i_i=1,i_n
+          IF (l_cgd) THEN
+!---------- the variable contains dimensions to be recombined
+!-----------
+!---------- open each file containing a small piece of data
+            CALL flrb_of (i_i,f_id_i)
+!-----------
+!---------- do the variable has offset at first/last block ?
+            l_cof = .FALSE.; l_col = .FALSE.;
+            IF (TRIM(c_d_n) == "apple") THEN
+              L_BF: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_cof = (d_h_s(i,i_i) /= 0)
+                    IF (l_cof)  EXIT L_BF
+                  ENDIF
+                ENDDO
+              ENDDO L_BF
+              L_BL: DO id=1,v_d_nb(iv)
+                DO i=1,SIZE(d_d_i)
+                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                    l_col = (d_h_e(i,i_i) /= 0)
+                    IF (l_col)  EXIT L_BL
+                  ENDIF
+                ENDDO
+              ENDDO L_BL
+            ENDIF
+!---------- if needed, redefine start and count for dimensions
+            l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
+            DO id=1,v_d_nb(iv)
+              DO i=1,SIZE(d_d_i)
+                IF (v_d_i(id,iv) == d_d_i(i)) THEN
+                  io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
+                  ia_sm(id) = 1
+                  io_sm(id) = d_p_f(i,i_i)
+                  io_cm(id) = io_n(id)
+                  IF     (TRIM(c_d_n) == "box") THEN
+                    ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
+                    io_sm(id) = io_sm(id)+d_h_s(i,i_i)
+                    io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
+                  ELSEIF (TRIM(c_d_n) == "apple") THEN
+                    IF (l_cof) THEN
+                      IF (d_h_s(i,i_i) /= 0) THEN
+                        ia_sf(id) = 1+d_h_s(i,i_i)
+                        io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
+                        io_cf(id) = io_n(id)-d_h_s(i,i_i)
+                      ELSE
+                        io_sf(id) = d_p_f(i,i_i)
+                        io_cf(id) = 1
+                        ia_sm(id) = ia_sm(id)+1
+                        io_sm(id) = io_sm(id)+1
+                        io_cm(id) = io_cm(id)-1
+                        l_o_f = .TRUE.
+                      ENDIF
+                    ENDIF
+                    IF (l_col) THEN
+                      IF (d_h_e(i,i_i) /= 0) THEN
+                        ia_sl(id) = 1
+                        io_sl(id) = d_p_f(i,i_i)
+                        io_cl(id) = io_n(id)-d_h_e(i,i_i)
+                      ELSE
+                        io_cm(id) = io_cm(id)-1
+                        ia_sl(id) = 1+io_n(id)-1
+                        io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
+                        io_cl(id) = 1
+                        l_o_l = .TRUE.
+                      ENDIF
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDDO
+            ENDDO
+            l_o_m = ALL(io_cm > 0)
+          ELSE
+!---------- the data can be read/write in one piece
+            f_id_i = f_id_i1
+          ENDIF
+!---------
+          IF (i_v_lev >= 3) THEN
+            WRITE (UNIT=*,FMT=*) &
+ &            TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
+            WRITE (UNIT=*,FMT=*) "io_i  : ",io_i(:)
+            WRITE (UNIT=*,FMT=*) "io_n  : ",io_n(:)
+            WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f
+            IF (l_o_f) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:)
+              WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_m : ",l_o_m
+            IF (l_o_m) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:)
+              WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:)
+            ENDIF
+            WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l
+            IF (l_o_l) THEN
+              WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:)
+              WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:)
+            ENDIF
+          ENDIF
+!---------
+!-------- Cases according to the type, shape and offsets of the data
+!---------
+          SELECT CASE (v_type(iv))
+!?INTEGERS of KIND 1 are not supported on all computers
+!?        CASE (flio_i1) !--- INTEGER 1
+!?          SELECT CASE (v_d_nb(iv))
+!?          CASE (0) !--- Scalar
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
+!?            CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
+!?          CASE (1) !--- 1d array
+!?            ALLOCATE(i1_1d(io_n(1)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_1d(ib(1):ie(1)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_1d)
+!?          CASE (2) !--- 2d array
+!?            ALLOCATE(i1_2d(io_n(1),io_n(2)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_2d)
+!?          CASE (3) !--- 3d array
+!?            ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_3d)
+!?          CASE (4) !--- 4d array
+!?            ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
+!? &                    ib(3):ie(3),ib(4):ie(4)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_4d)
+!?          CASE (5) !--- 5d array
+!?            ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
+!? &            start=io_i(:),count=io_n(:))
+!?            IF (l_o_f) THEN
+!?              ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sf(:),count=io_cf(:))
+!?            ENDIF
+!?            IF (l_o_m) THEN
+!?              ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sm(:),count=io_cm(:))
+!?            ENDIF
+!?            IF (l_o_l) THEN
+!?              ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+!? &                    ib(4):ie(4),ib(5):ie(5)), &
+!? &              start=io_sl(:),count=io_cl(:))
+!?            ENDIF
+!?            DEALLOCATE(i1_5d)
+!?          END SELECT
+!?        CASE (flio_i2) !--- INTEGER 2
+          CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i2_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i2_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i2_5d)
+            END SELECT
+          CASE (flio_i4) !--- INTEGER 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(i4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(i4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(i4_5d)
+            END SELECT
+          CASE (flio_r4) !--- REAL 4
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r4_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r4_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r4_5d)
+            END SELECT
+          CASE (flio_r8) !--- REAL 8
+            SELECT CASE (v_d_nb(iv))
+            CASE (0) !--- Scalar
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
+              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
+            CASE (1) !--- 1d array
+              ALLOCATE(r8_1d(io_n(1)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_1d(ib(1):ie(1)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_1d)
+            CASE (2) !--- 2d array
+              ALLOCATE(r8_2d(io_n(1),io_n(2)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_2d)
+            CASE (3) !--- 3d array
+              ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_3d)
+            CASE (4) !--- 4d array
+              ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
+ &                      ib(3):ie(3),ib(4):ie(4)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_4d)
+            CASE (5) !--- 5d array
+              ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
+              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
+ &              start=io_i(:),count=io_n(:))
+              IF (l_o_f) THEN
+                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sf(:),count=io_cf(:))
+              ENDIF
+              IF (l_o_m) THEN
+                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sm(:),count=io_cm(:))
+              ENDIF
+              IF (l_o_l) THEN
+                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
+                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
+ &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
+ &                      ib(4):ie(4),ib(5):ie(5)), &
+ &                start=io_sl(:),count=io_cl(:))
+              ENDIF
+              DEALLOCATE(r8_5d)
+            END SELECT
+          END SELECT
+!-------- eventually close each file containing a small piece of data
+          CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
+        ENDDO
+!------ If needed, deallocate io_* arrays
+        IF (v_d_nb(iv) > 0) THEN
+          DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
+          IF (TRIM(c_d_n) == "apple") THEN
+            DEALLOCATE(ia_sf,io_sf,io_cf)
+            DEALLOCATE(ia_sl,io_sl,io_cl)
+          ENDIF
+        ENDIF
+      ENDDO
+    ENDDO
+  ENDDO
+!-
+!-------------------
+! Ending the work
+!-------------------
+!-
+! Close files
+  CALL flrb_cf (0,.TRUE.)
+!-
+! Deallocate
+  DEALLOCATE(f_nm,f_a_id)
+  DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
+  DEALLOCATE(f_d_i,f_d_l)
+  DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
+  DEALLOCATE(d_d_i,d_s_g)
+  DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
+!-
+  IF (i_v_lev >= 1) THEN
+!-- elapsed and cpu time computation
+    CALL cpu_time (t_cpu_end)
+    CALL system_clock(count=nb_cc_end)
+    WRITE (UNIT=*,FMT='("")')
+    WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
+ &   REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
+    WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
+ &   t_cpu_end-t_cpu_ini
+  ENDIF
+!=======
+CONTAINS
+!=======
+SUBROUTINE flrb_of (i_f_n,i_f_i)
+!---------------------------------------------------------------------
+! Open the file of number "i_f_n" if necessary,
+! and returns its identifier in "i_f_i".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN)  :: i_f_n
+  INTEGER,INTENT(OUT) :: i_f_i
+!---------------------------------------------------------------------
+  IF (f_a_id(i_f_n) < 0) THEN
+    CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
+    f_a_id(i_f_n) = i_f_i
+  ELSE
+    i_f_i = f_a_id(i_f_n)
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_of
+!===
+SUBROUTINE flrb_cf (i_f_n,l_cf)
+!---------------------------------------------------------------------
+! Close the file of number "i_f_n" if "l_cf" is TRUE.
+! Close all files if "i_f_n <= 0".
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: i_f_n
+  LOGICAL,INTENT(IN) :: l_cf
+!---------------------------------------------------------------------
+  IF (i_f_n <= 0) THEN
+    CALL flioclo ()
+    f_a_id(:) = -1
+  ELSE
+    IF (l_cf) THEN
+      IF (f_a_id(i_f_n) < 0) THEN
+        CALL ipslerr (2,"flio_rbld", &
+ &       "The file",TRIM(f_nm(i_f_n)),"is already closed")
+      ELSE
+        CALL flioclo (f_a_id(i_f_n))
+        f_a_id(i_f_n) = -1
+      ENDIF
+    ENDIF
+  ENDIF
+!---------------------
+END SUBROUTINE flrb_cf
+!===
+SUBROUTINE flrb_rg
+!---------------------------------------------------------------------
+! Update valid_min valid_max attributes values
+!---------------------------------------------------------------------
+  INTEGER :: k,j
+  LOGICAL :: l_vmin,l_vmax
+  INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
+  REAL(KIND=r_4) :: r4_vmin,r4_vmax
+  REAL(KIND=r_8) :: r8_vmin,r8_vmax
+!---------------------------------------------------------------------
+  DO k=1,f_v_nb
+!-- get attribute informations
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
+    CALL flioinqa &
+ &    (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
+!---
+    IF (l_vmin.OR.l_vmax) THEN
+!---- get values of min/max
+      SELECT CASE (a_type)
+      CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d)
+            IF (j == 1) THEN
+              i4_vmin = i4_0d
+            ELSE
+              i4_vmin = MIN(i4_vmin,i4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
+            IF (j == 1) THEN
+              i4_vmax = i4_0d
+            ELSE
+              i4_vmax = MAX(i4_vmax,i4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
+        ENDIF
+      CASE (flio_r4) !--- REAL 4
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
+            IF (j == 1) THEN
+              r4_vmin = r4_0d
+            ELSE
+              r4_vmin = MIN(r4_vmin,r4_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
+            IF (j == 1) THEN
+              r4_vmax = r4_0d
+            ELSE
+              r4_vmax = MAX(r4_vmax,r4_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
+        ENDIF
+      CASE (flio_r8) !--- REAL 8
+        DO j=1,f_nb_in
+          CALL flrb_of (j,f_id_i)
+          IF (l_vmin) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
+            IF (j == 1) THEN
+              r8_vmin = r8_0d
+            ELSE
+              r8_vmin = MIN(r8_vmin,r8_0d)
+            ENDIF
+          ENDIF
+          IF (l_vmax) THEN
+            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
+            IF (j == 1) THEN
+              r8_vmax = r8_0d
+            ELSE
+              r8_vmax = MAX(r8_vmax,r8_0d)
+            ENDIF
+          ENDIF
+          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
+        ENDDO
+        IF (l_vmin) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
+        ENDIF
+        IF (l_vmax) THEN
+          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
+        ENDIF
+      END SELECT
+    ENDIF
+  ENDDO
+!---------------------
+END SUBROUTINE flrb_rg
+!===
+SUBROUTINE ZeroFill(f_id_o,f_v_nm,f_d_l,v_d_nb,v_type,v_d_i)
+
+  IMPLICIT NONE
+! Character length
+  INTEGER,PARAMETER :: chlen=256
+
+  INTEGER              :: v_d_nb, v_type ! variable # of dims, variable type, var Unlim dimension
+  INTEGER              :: f_id_o         ! Output file ID
+  INTEGER,DIMENSION(:) :: f_d_l, v_d_i    ! Global dimensions, variable dimensio ID
+  CHARACTER(LEN=chlen) :: f_v_nm         ! Variable name
+  INTEGER,DIMENSION(:),ALLOCATABLE :: dims
+
+  INTEGER(KIND=i_2) :: i2_0d
+  INTEGER(KIND=i_2), ALLOCATABLE :: i2_1d(:), i2_2d(:,:), i2_3d(:,:,:), i2_4d(:,:,:,:), i2_5d(:,:,:,:,:)
+  INTEGER(KIND=i_4) :: i4_0d
+  INTEGER(KIND=i_4), ALLOCATABLE :: i4_1d(:), i4_2d(:,:), i4_3d(:,:,:), i4_4d(:,:,:,:), i4_5d(:,:,:,:,:)
+  REAL(KIND=r_4) :: r4_0d
+  REAL(KIND=r_4), ALLOCATABLE    :: r4_1d(:), r4_2d(:,:), r4_3d(:,:,:), r4_4d(:,:,:,:), r4_5d(:,:,:,:,:)
+  REAL(KIND=r_8) :: r8_0d
+  REAL(KIND=r_8), ALLOCATABLE    :: r8_1d(:), r8_2d(:,:), r8_3d(:,:,:), r8_4d(:,:,:,:), r8_5d(:,:,:,:,:)
+  
+  ! write(*,*) ' Into my sub... TOM'
+  ! write(*,*) f_id_o, TRIM(f_v_nm), v_d_nb , v_type
+  write(*,*) 'Variable: ',TRIM(f_v_nm), ' intiliazed to zero'
+  write(*,*)
+
+  ! define variable dimension
+  ALLOCATE(dims(v_d_nb)) 
+  dims=f_d_l(v_d_i)
+  SELECT CASE(v_type) 
+    ! INTEGER 1 and 2 
+    CASE (flio_i1,flio_i2)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(i2_1d(dims(1)))
+         i2_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_1d)
+         DEALLOCATE(i2_1d)
+       CASE(2)
+         ALLOCATE(i2_2d(dims(1),dims(2)))
+         i2_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_2d) 
+         DEALLOCATE(i2_2d)
+       CASE(3)
+         ALLOCATE(i2_3d(dims(1),dims(2),dims(3)))
+         i2_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_3d)
+         DEALLOCATE(i2_3d)
+       CASE(4)
+         ALLOCATE(i2_4d(dims(1),dims(2),dims(3),dims(4)))
+         i2_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_4d)
+         DEALLOCATE(i2_4d)
+       CASE(5)
+         ALLOCATE(i2_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         i2_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i2_5d)
+         DEALLOCATE(i2_5d)
+      END SELECT
+    ! INTEGER 4
+    CASE (flio_i4)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(i4_1d(dims(1)))
+         i4_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_1d)
+         DEALLOCATE(i4_1d)
+       CASE(2)
+         ALLOCATE(i4_2d(dims(1),dims(2)))
+         i4_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_2d)
+         DEALLOCATE(i4_2d)
+       CASE(3)
+         ALLOCATE(i4_3d(dims(1),dims(2),dims(3)))
+         i4_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_3d)
+         DEALLOCATE(i4_3d)
+       CASE(4)
+         ALLOCATE(i4_4d(dims(1),dims(2),dims(3),dims(4)))
+         i4_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_4d)
+         DEALLOCATE(i4_4d)
+       CASE(5)
+         ALLOCATE(i4_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         i4_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),i4_5d)
+         DEALLOCATE(i4_5d)
+      END SELECT
+    ! FLOAT 4
+    CASE (flio_r4)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(r4_1d(dims(1)))
+         r4_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_1d) 
+         DEALLOCATE(r4_1d)
+       CASE(2)
+         ALLOCATE(r4_2d(dims(1),dims(2)))
+         r4_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_2d) 
+         DEALLOCATE(r4_2d)
+       CASE(3)
+         ALLOCATE(r4_3d(dims(1),dims(2),dims(3)))
+         r4_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_3d) 
+         DEALLOCATE(r4_3d)
+       CASE(4)
+         ALLOCATE(r4_4d(dims(1),dims(2),dims(3),dims(4)))
+         r4_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_4d)
+         DEALLOCATE(r4_4d)
+       CASE(5)
+         ALLOCATE(r4_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         r4_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r4_5d)
+         DEALLOCATE(r4_5d)
+      END SELECT
+    ! FLOAT 8
+    CASE (flio_r8)
+      SELECT CASE (v_d_nb)
+       CASE(1)
+         ALLOCATE(r8_1d(dims(1)))
+         r8_1d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_1d)
+         DEALLOCATE(r8_1d)
+       CASE(2)
+         ALLOCATE(r8_2d(dims(1),dims(2)))
+         r8_2d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_2d) 
+         DEALLOCATE(r8_2d)
+       CASE(3)
+         ALLOCATE(r8_3d(dims(1),dims(2),dims(3)))
+         r8_3d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_3d)
+         DEALLOCATE(r8_3d)
+       CASE(4)
+         ALLOCATE(r8_4d(dims(1),dims(2),dims(3),dims(4)))
+         r8_4d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_4d)
+         DEALLOCATE(r8_4d)
+       CASE(5)
+         ALLOCATE(r8_5d(dims(1),dims(2),dims(3),dims(4),dims(5)))
+         r8_5d=0
+         CALL flioputv (f_id_o,TRIM(f_v_nm),r8_5d)
+         DEALLOCATE(r8_5d)
+      END SELECT
+  END SELECT
+
+  DEALLOCATE (dims)
+
+END SUBROUTINE
+!===
+!--------------------
+END PROGRAM flio_rbld
Index: vendors/IOIPSL/tools/ncregular.f90
===================================================================
--- vendors/IOIPSL/tools/ncregular.f90	(revision 9621)
+++ vendors/IOIPSL/tools/ncregular.f90	(revision 9621)
@@ -0,0 +1,328 @@
+PROGRAM ncregular
+!
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!---------------------------------------------------------------------
+!- This code replaces a 2D surface grid by vectors.
+!- Obviously it only works if you have a regular grid.
+!-
+!- Jan Polcher (polcher@lmd.jussieu.fr)
+!- Jacques Bellier (jacques.bellier@cea.fr)
+!---------------------------------------------------------------------
+  USE netcdf
+!-
+  IMPLICIT NONE
+!-
+  INTEGER :: iread, if, in, iv, sz
+  INTEGER :: ier, nb_files, iret, ndims, nvars, nb_glat
+  INTEGER :: lon_dim_id, lat_dim_id
+  INTEGER :: lon_len, lat_len, lon_id, lat_id
+  INTEGER :: nav_lon_id, nav_lat_id
+  INTEGER :: alloc_stat_lon, alloc_stat_lat
+!-
+  INTEGER,ALLOCATABLE ::  file_id(:), tax_id(:)
+  CHARACTER(LEN=80),ALLOCATABLE :: names(:)
+  CHARACTER(LEN=80) :: dim_name
+  CHARACTER(LEN=80) :: varname
+  CHARACTER(LEN=20) :: xname, yname, lonname, latname
+  LOGICAL :: check, regular
+!-
+  REAL,ALLOCATABLE :: lon(:), lat(:), lon2(:), lat2(:)
+  REAL,ALLOCATABLE :: del_lon(:), del_lat(:)
+!-
+  INTEGER iargc, getarg
+  EXTERNAL iargc, getarg
+!---------------------------------------------------------------------
+  alloc_stat_lon = 0
+  alloc_stat_lat = 0
+!-
+  iread = iargc()
+!-
+  ALLOCATE (names(iread),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate names of size ', iread
+    STOP 'nctax'
+  ENDIF
+!-
+  CALL nct_getarg (iread, nb_files, names, check, &
+ &                 xname, yname, lonname, latname)
+!-
+! Allocate space
+!-
+  ALLOCATE (file_id(nb_files),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate file_id of size ', nb_files
+    STOP 'nctax'
+  ENDIF
+!-
+  ALLOCATE (tax_id(nb_files),stat=ier)
+  IF (ier /= 0) THEN
+    WRITE (*,*) ' Could not allocate tax_id of size ', nb_files
+    STOP 'nctax'
+  ENDIF
+!-
+  DO if=1,nb_files
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : ', if,  names(if)
+    ENDIF
+!---
+    iret = NF90_OPEN (names(if),NF90_WRITE,file_id(if))
+    iret = NF90_INQUIRE (file_id(if),ndims,nvars,nb_glat,tax_id(if))
+!---
+!-- Get the IDs of the variables
+!---
+    lon_len = -9999
+    lat_len = -9999
+    DO in=1,ndims
+!-----
+      iret = NF90_INQUIRE_DIMENSION (file_id(if), in, dim_name, sz)
+!-----
+      IF (     (LEN_TRIM(dim_name) == 1) &
+ &        .AND.(INDEX(dim_name,TRIM(xname)) == 1) ) THEN
+        lon_dim_id = in
+        lon_len = sz
+      ENDIF
+!-----
+      IF (     (LEN_TRIM(dim_name) == 1) &
+ &        .AND.(INDEX(dim_name,TRIM(yname)) == 1) ) THEN
+        lat_dim_id = in
+        lat_len = sz
+      ENDIF
+!-----
+    ENDDO
+!---
+    IF ( (lon_len == -9999).OR.(lat_len == -9999) ) THEN
+      WRITE(*,*) 'ncregular : The specified dimensions were not'
+      WRITE(*,*) 'found in file : ',names(if)
+      iret = NF90_CLOSE (file_id(if))
+      STOP
+    ENDIF
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : lon_dim_id, lon_len',lon_dim_id,lon_len
+      WRITE(*,*) 'ncregular : lat_dim_id, lat_len',lat_dim_id,lat_len
+    ENDIF
+!---
+!-- Look for the right variables
+!---
+    nav_lon_id = -9999
+    nav_lat_id = -9999
+    DO iv=1,nvars
+      iret = NF90_INQUIRE_VARIABLE (file_id(if),iv,name=varname)
+      IF (INDEX(varname,TRIM(lonname)) > 0) THEN
+        nav_lon_id = iv
+      ENDIF
+      IF (INDEX(varname,TRIM(latname)) > 0) THEN
+        nav_lat_id = iv
+      ENDIF
+    ENDDO
+!---
+    IF ( (nav_lon_id == -9999).OR.(nav_lat_id == -9999) ) THEN
+      WRITE(*,*) 'ncregular : The specified coordinate fields'
+      WRITE(*,*) 'were not found in file : ',names(if)
+      iret = NF90_CLOSE (file_id(if))
+      STOP
+    ENDIF
+!---
+    IF (check) THEN
+      WRITE(*,*) 'ncregular : nav_lon_id :', nav_lon_id
+      WRITE(*,*) 'ncregular : nav_lat_id :', nav_lat_id
+    ENDIF
+!---
+!-- Read variables from file and check if regular
+!---
+!-- Do we have the variable to read the
+!---
+    IF ( alloc_stat_lon < lon_len) THEN
+      IF ( alloc_stat_lon > 0) THEN
+        deallocate(lon)
+        deallocate(lon2)
+        deallocate(del_lon)
+      ENDIF
+      allocate(lon(lon_len))
+      allocate(lon2(lon_len))
+      allocate(del_lon(lon_len))
+      alloc_stat_lon = lon_len
+    ENDIF
+!---
+    IF ( alloc_stat_lat < lat_len) THEN
+      IF ( alloc_stat_lat > 0) THEN
+        deallocate(lat)
+        deallocate(lat2)
+        deallocate(del_lat)
+      ENDIF
+      allocate(lat(lat_len))
+      allocate(lat2(lat_len))
+      allocate(del_lat(lat_len))
+      alloc_stat_lat = lat_len
+    ENDIF
+!---
+!-- Read data
+!---
+    iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon, &
+ & start=(/1,1/),count=(/lon_len,1/),stride=(/1,1/))
+    iret = NF90_GET_VAR (file_id(if),nav_lon_id,lon2, &
+ & start=(/1,int(lat_len/2)/),count=(/lon_len,1/),stride=(/1,1/))
+    del_lon = lon-lon2
+!-
+    iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat, &
+ & start=(/1,1/),count=(/1,lat_len/),stride=(/lon_len,1/))
+    iret = NF90_GET_VAR (file_id(if),nav_lat_id,lat2, &
+ & start=(/int(lon_len/2),1/),count=(/1,lat_len/),stride=(/lon_len,1/))
+    del_lat = lat-lat2
+!-
+    regular = (    (MAXVAL(del_lon) < 0.001) &
+ &             .OR.(MAXVAL(del_lat) < 0.001) )
+!---
+!-- Create the new variables
+!---
+    IF (regular) THEN
+      IF (check) THEN
+        WRITE(*,*) 'Regular case'
+      ENDIF
+      iret = NF90_REDEF (file_id(if))
+      iret = NF90_RENAME_DIM (file_id(if), lon_dim_id, 'lon')
+      iret = NF90_RENAME_DIM (file_id(if), lat_dim_id, 'lat')
+      IF (check) THEN
+        WRITE(*,*) 'Dimensions renamed'
+      ENDIF
+      iret = NF90_DEF_VAR (file_id(if), 'lon', NF90_FLOAT, &
+ &                         lon_dim_id, lon_id)
+      iret = NF90_DEF_VAR (file_id(if), 'lat', NF90_FLOAT, &
+ &                         lat_dim_id, lat_id)
+      IF (check) THEN
+        WRITE(*,*) 'New variables defined'
+      ENDIF
+!-----
+!---- Copy attributes
+!-----
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'units', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'title', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_max', &
+ &                          file_id(if),lon_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lon_id,'valid_min', &
+ &                          file_id(if),lon_id)
+!-----
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'units', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'title', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_max', &
+ &                          file_id(if),lat_id)
+      iret = NF90_COPY_ATT (file_id(if),nav_lat_id,'valid_min', &
+ &                          file_id(if),lat_id)
+!-----
+!---- Go into write mode
+!-----
+      iret = NF90_ENDDEF (file_id(if))
+!-----
+!---- Write data
+!-----
+      iret = NF90_PUT_VAR (file_id(if),lon_id,lon(1:lon_len))
+      iret = NF90_PUT_VAR (file_id(if),lat_id,lat(1:lat_len))
+!-
+      iret = NF90_CLOSE (file_id(if))
+    ELSE
+      WRITE(*,*) 'ncregular : Your grid is not regular'
+      WRITE(*,*) names(if), 'remains unchanged'
+      iret = NF90_CLOSE (file_id(if))
+    ENDIF
+!-
+  ENDDO
+!--------------------
+END PROGRAM ncregular
+!-
+!===
+!-
+SUBROUTINE nct_getarg (argx, nb_files, names, check, &
+ &                     xname, yname, lonname, latname)
+!---------------------------------------------------------------------
+!- Read the arguments of nctax.
+!---------------------------------------------------------------------
+  INTEGER,INTENT(in) :: argx
+  INTEGER, INTENT(out) :: nb_files
+  CHARACTER(LEN=80),INTENT(out) :: names(argx)
+  CHARACTER(LEN=20) :: xname, yname, lonname, latname
+!-
+  CHARACTER(LEN=80) :: tmp, tmp_arg
+  LOGICAL :: check
+!---------------------------------------------------------------------
+  check = .FALSE.
+!-
+! Get the number of arguments
+!-
+  nb_files = 0
+!-
+  xname = 'x'
+  yname = 'y'
+  lonname = 'nav_lon'
+  latname = 'nav_lat'
+!-
+! Go through the arguments and analyse them one by one
+!-
+  IF (check) WRITE(*,*) 'Start going through the arguments'
+!-
+  IF (argx == 0) THEN
+    WRITE(*,*) 'To get usage : nctax -h '
+    STOP
+  ENDIF
+!-
+  iread = 1
+  DO WHILE (iread <= argx)
+    iret = getarg(iread,tmp)
+    IF (check) WRITE(*,*) ' iread, tmp :', iread, tmp
+    SELECTCASE(tmp)
+      CASE('-d')
+        WRITE(*,*) 'DEBUG MODE SELECTED'
+        check = .TRUE.
+        iread = iread+1
+      CASE('-h')
+        WRITE(*,*) 'Usage : nregular [options] file1 [file2 ...]'
+        WRITE(*,*) '    -d : Verbose mode'
+        WRITE(*,*) '    -h : This output'
+        STOP
+      CASE('-dim_lon')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        xname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-dim_lat')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        yname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-coo_lon')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        lonname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE('-coo_lat')
+        iread = iread+1
+        iret  = getarg(iread,tmp_arg)
+        latname = TRIM(tmp_arg)
+        iread = iread+1
+      CASE DEFAULT
+        IF (check) WRITE(*,*) 'nct_getarg : CASE default'
+        IF (INDEX(tmp,'-') /= 1) THEN
+          nb_files = nb_files+1
+          names(nb_files) = tmp
+          iread = iread+1
+        ELSE
+          WRITE(*,*) "WARNING Unknown option ",tmp
+          WRITE(*,*) "For ore information : nctax -h"
+        ENDIF
+    END SELECT
+  ENDDO
+!-
+  IF (check) THEN
+    WRITE(*,*) ' nct_getarg : output >> '
+    WRITE(*,*) '>> nb_files : ', nb_files
+    WRITE(*,*) '>> names :', (names(ii), ii=1,nb_files)
+  ENDIF
+!------------------------
+END SUBROUTINE nct_getarg
Index: vendors/IOIPSL/tools/ncunderflow.f90
===================================================================
--- vendors/IOIPSL/tools/ncunderflow.f90	(revision 9621)
+++ vendors/IOIPSL/tools/ncunderflow.f90	(revision 9621)
@@ -0,0 +1,393 @@
+MODULE declare
+! -*- Mode: f90 -*-
+!$Id$
+!-
+! This software is governed by the CeCILL license
+! See IOIPSL/IOIPSL_License_CeCILL.txt
+!-
+! f90 -L/usr/local/lib -lnetcdf -align dcommons -g
+!     -ladebug -check format -check bounds
+!     -check output_conversion -fpe1
+!     -I/usr/local/include -free -arch host -tune host
+!     -warn declarations -warn argument_checking
+!     ncunderflow.f  -o ncunderflow
+!
+! ifc -FR -cl,ncunderflow.pcl -o ncunderflow ncunderflow.f
+!     -L/usr/local/install/netcdf/lib/libnetcdf.a -lPEPCF90
+!
+  IMPLICIT NONE
+  INTEGER, PARAMETER :: r4 = 4, r8 = 8, i4 = 4, i8 = 8
+  INTEGER, PARAMETER :: il = KIND(1)
+  LOGICAL :: ldebug = .FALSE.
+  INTEGER (kind = il) :: nout = 0, nerr = 0         ! Standard output, standard error
+  CHARACTER (LEN=4), PARAMETER :: cerror = 'VOID'
+END MODULE declare
+!!
+MODULE mod_nfdiag
+CONTAINS
+  SUBROUTINE nfdiag ( kios, clmess, lcd)
+    !!
+    !! Imprime un message d'erreur NetCDF
+    !!
+    USE declare
+    IMPLICIT NONE
+    INCLUDE 'netcdf.inc'
+    !!
+    INTEGER (kind=i4), INTENT (in) :: kios
+    CHARACTER (len = *), INTENT (in) :: clmess
+    LOGICAL, INTENT (in), OPTIONAL :: lcd 
+    CHARACTER (len = 80) :: clt
+    LOGICAL :: ld
+    !!
+    IF ( PRESENT ( lcd)) THEN
+        ld = lcd
+    ELSE
+        ld = ldebug
+    ENDIF
+    !!
+    clt = TRIM ( NF_STRERROR ( kios) )
+    !!
+    IF ( ld ) THEN 
+        IF ( kios == NF_NOERR ) THEN 
+            WRITE ( unit = nout, fmt = * ) "OK : ", TRIM (clmess)
+        ELSE
+            WRITE ( unit = nout, fmt = * ) "ERROR : ", TRIM (clmess), " : ", TRIM ( clt), " : ", kios
+            IF ( .NOT. ld ) STOP
+        END IF
+    ELSE
+        IF ( kios /= NF_NOERR ) THEN 
+            WRITE ( unit = nout, fmt = * ) "ERROR : ", TRIM (clmess), " : ", TRIM ( clt), " : ", kios
+            STOP
+        END IF
+    ENDIF
+    !!
+    RETURN
+    !!
+  END SUBROUTINE nfdiag
+  !!
+END MODULE mod_nfdiag
+
+MODULE mod_lec
+CONTAINS
+  !!
+  SUBROUTINE lec (chaine, cval, c_c)
+    !!
+    USE declare
+    IMPLICIT NONE
+    !!
+    CHARACTER (len = *), INTENT ( inout) :: chaine
+    CHARACTER (len = *), INTENT ( inout) :: cval
+    CHARACTER (len=*), OPTIONAL :: c_c
+    INTEGER (kind = il) :: ji, ji1, ji2, ji3, jl, jb
+    INTEGER (kind = i4) :: index
+    !!
+    !! Read character string up to ':' or ',', or in c_c if present
+    !! Returns the real before the character (xerror if not available)
+    !! Reduce the string
+    !!
+    jl = LEN (chaine) ; jb = LEN_TRIM (chaine)
+    IF ( ldebug) WRITE ( nout, *) 'Lec : jl, jb ', jl, jb
+    IF ( jb == 0 ) THEN 
+        cval = cerror
+    ELSE
+        ji1 = INDEX (chaine, ':') ; ji2 = INDEX (chaine, ',')
+        IF ( PRESENT (c_c)) THEN 
+            ji3 = INDEX (chaine, c_c) ; ji = MAX (ji1, ji2, ji3)
+        ELSE
+            ji = MAX (ji1, ji2)
+        ENDIF
+        IF ( ji == 0 ) THEN 
+            READ ( chaine (1:jb) , fmt = * ) cval
+            chaine (1:jl-jb) = chaine (jb+1:jl)
+        ELSE IF ( ji == 1 ) THEN 
+            cval = cerror
+            chaine (1:jl-1) = chaine (2:jl)
+        ELSE
+            cval = chaine (1:ji-1)
+            chaine (1:jl-ji) = chaine (ji+1:jl )
+        END IF
+    END IF
+    !!
+  END SUBROUTINE lec
+END MODULE mod_lec
+
+PROGRAM ncunderflow
+
+  ! Ce programme ouvre un fichier de donnees au format netcdf
+  ! et met a zero toutes les valeurs trop petites pour etre
+  ! representees par un reel sur 4 octets au format IEEE
+  !
+  ! Revision 2.0  2004/04/05 14:47:50  adm
+  ! JB+MAF+AC: switch to IOIPSL 2.0 (1)
+  !
+  ! Revision 1.1  2003/04/09 15:21:56  adm
+  ! add ncunderflow in IOIPSL
+  ! and modify AA_make to take it into account
+  ! SD + MAF
+  !
+  ! Revision 1.1  2001/02/07  14:36:07  jypeter
+  ! J-Y Peterschmitt / LMCE / 07/02/2001
+  ! Initial revision
+  !
+  USE declare
+  USE mod_nfdiag
+  USE mod_lec
+  IMPLICIT NONE
+
+  INCLUDE 'netcdf.inc'
+
+  INTEGER (kind=il), EXTERNAL :: iargc
+
+  ! Nombre maximal de dimensions : 6
+
+  INTEGER (kind=il), PARAMETER :: jpmaxdim = 6, jpmaxvar = 1024
+
+  CHARACTER (len = 128) :: clnomprog, clnomfic
+  CHARACTER (len = 1024) :: clistvar, clecline
+  CHARACTER (len = 128), DIMENSION(jpmaxdim) :: clnomdim
+  CHARACTER (len = 128), DIMENSION(jpmaxvar) :: clvarcmd, clvarfic, clvar ! Nom des variables dans le fichier est sur la ligne de commande.
+  LOGICAL :: lrever = .FALSE. ! Si .true., on traite toutes les variables sauf celle de la ligne de commande
+  LOGICAL :: lnocoord = .FALSE. ! Si .truee., on exclu les variables coordonnées
+  LOGICAL :: lverbose = .TRUE.
+  
+  INTEGER (kind=il) :: incid, ircode, ivarid, ivartype, inbdim, inbatt
+  INTEGER (kind=il) :: nvarcmd, nvarfic, nvar, nfile, jvarcmd, jvarfic, jvar, jfile, ierr
+  INTEGER (kind=il) :: ji, jdim3, jdim4, jdim5, jdim6, j1, j2, j3, jarg, ncumul
+  INTEGER (kind=il), DIMENSION(jpmaxdim) :: idimid, idimsize, istart, icount
+  REAL (kind=r4), DIMENSION(:,:), ALLOCATABLE :: zdatacorr
+  REAL (kind=r8), DIMENSION(:,:), ALLOCATABLE :: zdata
+  REAL (kind=r4) :: reps = TINY (1.0_r4) * 10.0_r4
+  LOGICAL :: lok
+
+  ! Verification du nombre de parametres
+  IF(iargc() .LT. 2) THEN
+      CALL usage
+      STOP
+  ENDIF
+
+  ! Aide
+  jarg = 1
+  Lab1: DO WHILE ( jarg <= 3 )
+    IF (ldebug) WRITE(nout,*) 'lecture ligne commande ', jarg
+    CALL getarg (jarg,clecline)
+    IF ( clecline(1:1) /= '-' ) EXIT Lab1
+    IF ( clecline(1:2) == '-h' .OR. clecline(1:2) == '-?'  ) THEN
+        CALL usage
+        STOP 
+    ELSE IF ( clecline(1:2) == '-x' ) THEN
+        lrever = .TRUE. 
+    ELSE IF ( clecline(1:2) == '-d' ) THEN
+        ldebug = .TRUE. 
+    ELSE IF ( clecline(1:2) == '-V' ) THEN
+        lverbose = .FALSE. 
+    ELSE IF ( clecline(1:2) == '-v' ) THEN
+        jarg = jarg + 1
+        ! Recuperation des noms de variables
+        IF (ldebug) WRITE(nout,*) 'lecture liste vriables ', jarg
+        CALL getarg (jarg,clistvar)
+        clistvar = TRIM(ADJUSTL(clistvar))
+        jvarcmd = 0 ; nvarcmd = 0
+        SeekVar: DO WHILE ( .TRUE. )
+          CALL lec ( clistvar, clvarcmd(jvarcmd+1)(:) )
+          IF ( TRIM(clvarcmd(jvarcmd+1)(:)) == cerror ) EXIT SeekVar
+          jvarcmd = jvarcmd + 1
+          nvarcmd = jvarcmd
+          IF (ldebug) WRITE(nout,*) 'affecte variable ', jvarcmd, TRIM(clvarcmd(jvarcmd))
+        END DO SeekVar
+    ENDIF
+    jarg = jarg + 1
+  END DO Lab1
+
+  ! Boucle sur les fichiers
+  FileLoop: DO jfile = jarg, iargc()
+    
+    ! Recuperation du nom du fichier a traiter
+    CALL getarg ( jfile, clnomfic)
+    
+    ! Ouverture du fichier
+    CALL nfdiag ( NF_OPEN ( TRIM(clnomfic), NF_WRITE, incid ), "Opening " // TRIM(clnomfic) )
+    WRITE (nout,*) TRIM(clnomfic)
+
+    ! Recuparation de la liste des variables du fichier
+    nvarfic = 0
+    DO jvarfic = 1, jpmaxvar
+      j3 = NF_INQ_VAR ( incid, jvarfic, clvarfic(jvarfic)(:), ivartype, inbdim, idimid, inbatt)
+      IF ( j3 /= NF_NOERR ) EXIT
+      nvarfic = jvarfic
+    END DO
+
+    ! Liste des variables a traiter
+    IF ( lrever ) THEN
+        IF ( nvarcmd == 0) THEN 
+            clvar = clvarfic
+            nvar  = nvarfic
+        ELSE 
+            jvar = 0
+            DO jvarfic = 1, nvarfic
+              lok = .TRUE.
+              DO jvarcmd = 1, nvarcmd
+                IF ( TRIM(clvarfic(jvarfic)(:)) == TRIM(clvarcmd(jvarcmd)(:)) ) THEN
+                    lok = .FALSE.
+                END IF
+              END DO
+              IF ( lok) THEN 
+                  jvar = jvar + 1
+                  clvar(jvar) = clvarfic(jvarfic)
+              END IF
+            END DO
+            nvar = jvar
+        END IF
+    ELSE
+        clvar = clvarcmd
+        nvar  = nvarcmd
+    END IF
+
+    ncumul = 0
+    VarLoop: DO jvar = 1, nvar 
+      
+      IF (lverbose) &
+         & WRITE(nout, FMT='("Correction de ", A, " dans ", A, " : ", $)') TRIM(clvar(jvar)(:)), TRIM(clnomfic)
+
+      ! Passage de netcdf en mode 'erreurs non fatales'
+      !  CALL ncpopt(NCVERBOS)
+      ! En fait, on reste dans le mode par defaut, dans lequel une erreur
+      ! netcdf cause un arret du programme. Du coup, il n'est pas
+      ! necessaire de tester la valeur de la variable ircode
+      ! ATTENTION! Si jamais on veut arreter le programme a cause d'une
+      ! erreur ne provenant pas de netcdf, il faut penser a fermer
+      ! manuellement le fichier avec un appel a ncclos
+      
+      ! Recuperation de l'identificateur de la variable
+      CALL nfdiag ( NF_INQ_VARID ( incid, TRIM(clvar(jvar)(:)), ivarid), "Get var id " // TRIM(clvar(jvar)(:)))
+
+      ivartype = 0 ; idimid = 0 ; inbdim = 0 ; inbatt = 0
+      ! Recuperation du nombre de dimensions de la variable
+      CALL nfdiag ( NF_INQ_VAR ( incid, ivarid, clvar(jvar)(:), ivartype, inbdim, idimid, inbatt),  &
+         & "Get var info " // TRIM(clvar(jvar)(:)))
+      
+      IF(inbdim .GT. jpmaxdim) THEN
+          WRITE(nout,*)
+          WRITE(nout, *) 'La variable ', TRIM(clvar(jvar)(:)), ' a trop de dimensions'
+          CALL nfdiag ( NF_CLOSE (incid), "Closing file")
+          STOP
+      ENDIF
+      
+      ! Recuperation des dimensions effectives
+      idimsize(3:jpmaxdim) = 1 ! Au cas ou la variable n'ait que
+      ! 2 ou 3 dims, on initialise ces valeurs
+      ! qui serviront dans le controle des boucles
+      ! et qui auraient une valeur indefinie sinon
+      DO ji = 1, inbdim
+        CALL nfdiag ( NF_INQ_DIM ( incid, idimid(ji), clnomdim(ji), idimsize(ji)), "NF_INQ_DIM")
+        IF (lverbose) WRITE(nout, '(A,A,A,I3,$)') '    ', TRIM(clnomdim(ji)), ' = ', idimsize(ji)
+        IF ( idimsize(ji) == 0 ) THEN
+            WRITE(nout, '(A,A,A,A,I3)') TRIM(clvar(jvar)(:)), ', ', TRIM(clnomdim(ji)), ' = ', idimsize(ji)
+            CYCLE VarLoop
+        END IF
+      ENDDO
+      IF (lverbose) WRITE(nout,*)
+      idimsize = MAX ( idimsize, 1)
+      ncumul = ncumul + 1
+      
+      ! Determination du type de la variable, en fonction du nom de
+      ! la premiere dimension
+!$$$  IF(INDEX(TRIM(clnomdim(1)),'ongitude') .NE. 0) THEN
+!$$$      ! var de type map ou 3d
+!$$$      write(nout, *) '  --> MAP/3D'
+!$$$  ELSE IF(INDEX(TRIM(clnomdim(1)),'atitude') .NE. 0) THEN
+!$$$      ! var de type xsec 
+!$$$      write(nout, *) '  --> XSEC'
+!$$$  ELSE
+!$$$      WRITE(nout, *)
+!$$$      WRITE(nout, *) 'Bizarre, la premiere dimension n''est ni "longitude" ni "latitude"'
+!$$$      CALL ncclos(incid, ircode)
+!$$$      STOP
+!$$$  ENDIF
+
+      ! Reservation de memoire pour charger et traiter
+      ! une grille idimsize(1)*idimsize(2) de la variable
+      ALLOCATE(zdata(idimsize(1), idimsize(2)), stat=ierr)
+      IF(ierr .NE. 0) THEN
+          WRITE(nout, *) 'Erreur d''allocation memoire pour zdata'
+          CALL nfdiag ( NF_CLOSE (incid), "NF_CLOSE")
+          STOP
+      ENDIF
+      ALLOCATE(zdatacorr(idimsize(1), idimsize(2)), stat=ierr)
+      IF(ierr .NE. 0) THEN
+          WRITE(nout, *) 'Erreur d''allocation memoire pour zdatacorr'
+          CALL nfdiag ( NF_CLOSE (incid), "NF_CLOSE")
+          STOP
+      ENDIF
+
+      ! Parametrisation de la partie de la variable a charger en memoire
+      ! (une 'grille' que l'on lira autant de fois qu'il y a de niveaux et
+      !  de pas de temps)
+      ! Rappel : seuls les elements 1..inbdim des tableaux sont
+      ! significatifs et utiles
+
+      icount = 0
+      
+      DO jdim6 = 1, idimsize(6)
+        DO jdim5 = 1, idimsize(5)
+          DO jdim4 = 1, idimsize(4)
+            DO jdim3 = 1, idimsize(3)
+              istart = (/   1        ,      1      , jdim3, jdim4, jdim5, jdim6 /)
+              icount = (/ idimsize(1),  idimsize(2),   1  ,  1   ,  1   ,  1    /)
+
+              ! Chargement d'une 'grille' de donnees, en real*8
+              CALL nfdiag ( NF_GET_VARA_DOUBLE(incid, ivarid, istart(1:inbdim), icount(1:inbdim), zdata), &
+                 & "NF_GET_VARA_DOUBLE")
+              ! Mise a zero de toutes les valeurs trop petites pour etre
+              ! representees par un reel sur 4 octets au format IEEE.
+              ! Le truc est de faire une operation nulle (addition de 0)
+              ! sur des donnees qui posent problemes, EN AYANT COMPILE LE PROG
+              ! AVEC l'OPTION "-fpe1". Dans ce cas, les valeurs trop petites
+              ! sont remplacees par zero (0.0) et le programme continue,
+              ! au lieu de planter.
+              ! Il est possible de faire afficher le nb de valeurs qui ont pose
+              ! un pb en utilisant en plus l'option "-check underflow"
+              zdata = zdata + 0.0_r8
+              zdatacorr = REAL(zdata, KIND=r4)
+              WHERE ( ABS (zdatacorr) < reps) zdatacorr = 0.0_r4
+              
+              ! Sauvegarde de la grille corrigee dans le fichier
+              ! (a la place de la grille initiale), en real*4
+              CALL nfdiag ( NF_PUT_VARA_REAL(incid, ivarid, istart, icount, zdatacorr), "NF_PUT_VARA_REAL" )
+              
+            END DO
+          END DO
+        END DO
+      END DO
+      
+      DEALLOCATE ( zdata)
+      DEALLOCATE ( zdatacorr)
+      
+    END DO VarLoop
+    
+    WRITE (nout,*) 'ncunderflow, nombre de variables corrigees : ', ncumul
+
+    ! Fermeture du fichier
+    CALL nfdiag ( NF_CLOSE (incid), "Closing" )
+    
+  END DO FileLoop
+
+CONTAINS
+  SUBROUTINE usage
+    IMPLICIT NONE
+    CALL getarg (0, clnomprog)
+
+    WRITE(nout, FMT='("Command : ", A)') TRIM(clnomprog)
+    WRITE(nout, FMT='("Removes underflows in NetCDF files") ')
+    WRITE(nout, FMT='("Usage : ", A, " [-x] [-V] [-d] -v nomvar[,nomvar] nomfic [nomfic]")' ) TRIM(clnomprog)
+    WRITE(nout, FMT='("Options : ")' )
+    WRITE(nout, FMT='("  -V : mode verbose off. Default is verbose on.")' )
+    WRITE(nout, FMT='("  -d : debug mode on. Default is debug off.")' )
+    WRITE(nout, FMT='("  -v : gives list of variables to be corrected, separated by a coma.")' )
+    WRITE(nout, FMT='("  -x : reverses meaning of -v : given variable are not corrected")' )
+    WRITE(nout, FMT='("       if -x is given, and not -v, all variables are corrected.")' )
+    
+    
+    STOP
+  END SUBROUTINE usage
+  
+END PROGRAM ncunderflow
Index: vendors/IOIPSL/tools/rebuild
===================================================================
--- vendors/IOIPSL/tools/rebuild	(revision 9621)
+++ vendors/IOIPSL/tools/rebuild	(revision 9621)
@@ -0,0 +1,110 @@
+#!/bin/ksh
+#
+#$Id$
+#
+# This software is governed by the CeCILL license
+# See IOIPSL/IOIPSL_License_CeCILL.txt
+#---------------------------------------------------------------------
+# @(#)Rebuild IOIPSL domains
+#---------------------------------------------------------------------
+function rebuild_Usage
+{
+print - "
+\"${b_n}\"
+  rebuild a model_file from several input files.
+Each input file contains the model_data for a domain.
+
+Usage :
+  ${b_n} [-h]
+  ${b_n} [-v level] [-f] -o output_file_name input_file_names
+
+Options :
+  -h         : help
+  -v O/1/2/3 : verbose mode (verbosity increasing with level)
+  -f         : executing mode
+               (execute the program even if the number of input files
+                is not equal to the total number of domains)
+"
+}
+#-
+#set -xv
+#-
+# Extract the calling sequence of the script (d_n/b_n)
+#-
+d_n=${0%/*}; b_n=${0##*/};
+#-
+# Retrieving the options
+#-
+r_v='0'; r_f='noforce'; r_o="";
+while getopts :hv:fo: V
+ do
+  case $V in
+   (h) rebuild_Usage; exit 0;;
+   (v) r_v=${OPTARG};;
+   (f) r_f='force';;
+   (o) r_o=${OPTARG};;
+   (:) print -u2 "${b_n} : missing value for option $OPTARG"; exit 2;;
+   (\?) print -u2 "${b_n} : option $OPTARG not supported"; exit 2;;
+  esac
+ done
+shift $(($OPTIND-1));
+#-
+# Validate the -v option
+#-
+case ${r_v} in
+  ( 0 | 1 | 2 | 3 );;
+  ("") r_v='0';;
+  (*)
+    print -u2 "${b_n} :";
+    print -u2 "Invalid verbosity level requested : ${r_v}";
+    print -u2 "(must be 0, 1, 2 or 3)";
+    exit 1;;
+esac
+#-
+# Validate the number of arguments
+#-
+[[ ${#} < 1 ]] && \
+ {
+  print -u2 "${b_n} : Too few arguments have been specified. (Use -h)";
+  exit 3;
+ }
+#-
+# Check for the output file name
+#-
+[[ -z ${r_o} ]] && \
+ {
+  r_o='rebuilt_file.nc';
+  print -u2 - "
+   ${b_n} : output_file_name not specified. (Use -h)
+            rebuilt_file.nc should be created."
+ }
+#-
+# Validate the names of the input files
+#-
+for i in $*;
+ do
+  [[ ! -f ${i} ]] && { echo "${i} unreachable ..."; exit 3;}
+ done
+#-
+# Create the information file for the program
+#-
+echo ${r_v} > tmp.$$;
+echo ${r_f} >> tmp.$$;
+echo $((${#}+1)) >> tmp.$$;
+for i in $*;
+ do echo ${i} >> tmp.$$;
+ done
+echo ${r_o} >> tmp.$$;
+#-
+# Create the output file
+#-
+${d_n}/flio_rbld.exe < tmp.$$
+r_c=$?
+#-
+# Clear
+#-
+rm -f tmp.$$
+#-
+# End
+#-
+exit ${r_c};
Index: vendors/IOIPSL/tools/tkcond.c
===================================================================
--- vendors/IOIPSL/tools/tkcond.c	(revision 9621)
+++ vendors/IOIPSL/tools/tkcond.c	(revision 9621)
@@ -0,0 +1,546 @@
+/* parser config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * The general idea here is that we want to parse a config.in file and 
+ * from this, we generate a wish script which gives us effectively the
+ * same functionality that the original config.in script provided.
+ *
+ * This task is split roughly into 3 parts.  The first parse is the parse
+ * of the input file itself.  The second part is where we analyze the 
+ * #ifdef clauses, and attach a linked list of tokens to each of the
+ * menu items.  In this way, each menu item has a complete list of
+ * dependencies that are used to enable/disable the options.
+ * The third part is to take the configuration database we have build,
+ * and build the actual wish script.
+ *
+ * This file contains the code to further process the conditions from
+ * the "ifdef" clauses.
+ *
+ * The conditions are assumed to be one of the following formats
+ *
+ * simple_condition:= "$VARIABLE" == y/n/m
+ * simple_condition:= "$VARIABLE != y/n/m
+ *
+ * simple_condition -a simple_condition
+ *
+ * If the input condition contains '(' or ')' it would screw us up, but for now
+ * this is not a problem.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "tkparse.h"
+
+
+/*
+ * Walk a condition chain and invert it so that the logical result is
+ * inverted.
+ */
+static void invert_condition(struct condition * cnd)
+{
+  /*
+   * This is simple.  Just walk through the list, and invert
+   * all of the operators.
+   */
+  for(;cnd; cnd = cnd->next)
+    {
+      switch(cnd->op)
+	{
+	case op_and:
+	  cnd->op = op_or;
+	  break;
+	case op_or:
+	  /*
+	   * This is not turned into op_and - we need to keep track
+	   * of what operators were used here since we have an optimization
+	   * later on to remove duplicate conditions, and having
+	   * inverted ors in there would make it harder if we did not
+	   * distinguish an inverted or from an and we inserted because
+	   * of nested ifs.
+	   */
+	  cnd->op = op_and1;
+	  break;
+	case op_neq:
+	  cnd->op = op_eq;
+	  break;
+	case op_eq:
+	  cnd->op = op_neq;
+	  break;
+	default:
+	  break;
+	}
+    }
+}
+
+/*
+ * Walk a condition chain, and free the memory associated with it.
+ */
+static void free_condition(struct condition * cnd)
+{
+  struct condition * next;
+  for(;cnd; cnd = next)
+    {
+      next = cnd->next;
+
+      if( cnd->variable.str != NULL )
+	free(cnd->variable.str);
+
+      free(cnd);
+    }
+}
+
+/*
+ * Walk all of the conditions, and look for choice values.  Convert
+ * the tokens into something more digestible.
+ */
+void fix_choice_cond()
+{
+  struct condition * cond;
+  struct condition * cond2;
+  struct kconfig * cfg;
+  char tmpbuf[10];
+
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->cond == NULL )
+	{
+	  continue;
+	}
+
+      for(cond = cfg->cond; cond != NULL; cond = cond->next)
+	{
+	  if( cond->op != op_kvariable )
+	    continue;
+
+	  if( cond->variable.cfg->tok != tok_choice )
+	    continue;
+
+	  /*
+	   * Look ahead for what we are comparing this to.  There should
+	   * be one operator in between.
+	   */
+	  cond2 = cond->next->next;
+	  strcpy(tmpbuf, cond->variable.cfg->label);
+
+	  if( strcmp(cond2->variable.str, "y") == 0 )
+	    {
+	      cond->variable.cfg = cond->variable.cfg->choice_label;
+	      cond2->variable.str = strdup(tmpbuf);
+	    }
+	  else
+	    {
+	      fprintf(stderr,"Ooops\n");
+	      exit(0);
+	    }
+	}
+
+    }
+}
+
+/*
+ * Walk the stack of conditions, and clone all of them with "&&" operators
+ * gluing them together.  The conditions from each level of the stack
+ * are wrapped in parenthesis so as to guarantee that the results
+ * are logically correct.
+ */
+struct condition * get_token_cond(struct condition ** cond, int depth)
+{
+  int i;
+  struct condition * newcond;
+  struct condition * tail;
+  struct condition * new;
+  struct condition * ocond;
+  struct kconfig * cfg;
+
+  newcond = tail = NULL;
+  for(i=0; i<depth; i++, cond++)
+    {
+      /*
+       * First insert the left parenthesis
+       */
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = op_lparen;
+      if( tail == NULL )
+	{
+	  newcond = tail = new;
+	}
+      else
+	{
+	  tail->next = new;
+	  tail = new;
+	}
+
+      /*
+       * Now duplicate the chain.
+       */
+      ocond = *cond;
+      for(;ocond != NULL; ocond = ocond->next)
+	{
+	  new = (struct condition *) malloc(sizeof(struct condition));
+	  memset(new, 0, sizeof(*new));
+	  new->op = ocond->op;
+	  if( ocond->variable.str != NULL )
+	    {
+	      if( ocond->op == op_variable )
+		{
+		  /*
+		   * Search for structure to insert here.
+		   */
+		  for(cfg = config;cfg != NULL; cfg = cfg->next)
+		    {
+		      if( cfg->tok != tok_bool
+		         && cfg->tok != tok_int
+		         && cfg->tok != tok_hex
+			 && cfg->tok != tok_tristate 
+			 && cfg->tok != tok_choice
+			 && cfg->tok != tok_dep_tristate)
+			{
+			  continue;
+			}
+		      if( strcmp(cfg->optionname, ocond->variable.str) == 0)
+			{
+			  new->variable.cfg = cfg;
+			  new->op = op_kvariable;
+			  break;
+			}
+		    }
+		  if( cfg == NULL )
+		    {
+		      new->variable.str = strdup(ocond->variable.str);
+		    }
+		}
+	      else
+		{
+		  new->variable.str = strdup(ocond->variable.str);
+		}
+	    }
+	  tail->next = new;
+	  tail = new;
+	}
+
+      /*
+       * Next insert the left parenthesis
+       */
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = op_rparen;
+      tail->next = new;
+      tail = new;
+
+      /*
+       * Insert an and operator, if we have another condition.
+       */
+      if( i < depth - 1 )
+	{
+	  new = (struct condition *) malloc(sizeof(struct condition));
+	  memset(new, 0, sizeof(*new));
+	  new->op = op_and;
+	  tail->next = new;
+	  tail = new;
+	}
+
+    }
+
+  return newcond;
+}
+
+/*
+ * Walk a single chain of conditions and clone it.  These are assumed
+ * to be created/processed by  get_token_cond in a previous pass.
+ */
+struct condition * get_token_cond_frag(struct condition * cond, 
+				       struct condition ** last)
+{
+  struct condition * newcond;
+  struct condition * tail;
+  struct condition * new;
+  struct condition * ocond;
+
+  newcond = tail = NULL;
+
+  /*
+   * Now duplicate the chain.
+   */
+  for(ocond = cond;ocond != NULL; ocond = ocond->next)
+    {
+      new = (struct condition *) malloc(sizeof(struct condition));
+      memset(new, 0, sizeof(*new));
+      new->op = ocond->op;
+      new->variable.cfg = ocond->variable.cfg;
+      if( tail == NULL )
+	{
+	  newcond = tail = new;
+	}
+      else
+	{
+	  tail->next = new;
+	  tail = new;
+	}
+    }
+
+  new = (struct condition *) malloc(sizeof(struct condition));
+  memset(new, 0, sizeof(*new));
+  new->op = op_and;
+  tail->next = new;
+  tail = new;
+  
+  *last = tail;
+  return newcond;
+}
+
+/*
+ * Walk through the if conditionals and maintain a chain.
+ */
+void fix_conditionals(struct kconfig * scfg)
+{
+  int depth = 0;
+  int i;
+  struct kconfig * cfg;
+  struct kconfig * cfg1;
+  struct condition * conditions[25];
+  struct condition * cnd;
+  struct condition * cnd1;
+  struct condition * cnd2;
+  struct condition * cnd3;
+  struct condition * newcond;
+  struct condition * last;
+
+  /*
+   * Start by walking the chain.  Every time we see an ifdef, push
+   * the condition chain on the stack.  When we see an "else", we invert
+   * the condition at the top of the stack, and when we see an "endif"
+   * we free all of the memory for the condition at the top of the stack
+   * and remove the condition from the top of the stack.
+   *
+   * For any other type of token (i.e. a bool), we clone a new condition chain
+   * by anding together all of the conditions that are currently stored on
+   * the stack.  In this way, we have a correct representation of whatever
+   * conditions govern the usage of each option.
+   */
+  memset(conditions, 0, sizeof(conditions));
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch(cfg->tok)
+	{
+	case tok_if:
+	  /*
+	   * Push this condition on the stack, and nuke the token
+	   * representing the ifdef, since we no longer need it.
+	   */
+	  conditions[depth] = cfg->cond;
+	  depth++;
+	  cfg->tok = tok_nop;
+	  cfg->cond =  NULL;
+	  break;
+	case tok_else:
+	  /*
+	   * For an else, we just invert the condition at the top of
+	   * the stack.  This is done in place with no reallocation
+	   * of memory taking place.
+	   */
+	  invert_condition(conditions[depth-1]);
+	  cfg->tok = tok_nop;
+	  break;
+	case tok_fi:
+	  depth--;
+	  free_condition(conditions[depth]);
+	  conditions[depth] = NULL;
+	  cfg->tok = tok_nop;
+	  break;
+	case tok_comment:
+	case tok_define:
+	case tok_menuoption:
+	case tok_bool:
+	case tok_tristate:
+	case tok_int:
+	case tok_hex:
+	case tok_choice:
+	case tok_make:
+	  /*
+	   * We need to duplicate the chain of conditions and attach them to
+	   * this token.
+	   */
+	  cfg->cond = get_token_cond(&conditions[0], depth);
+	  break;
+	case tok_dep_tristate:
+	  /*
+	   * Same as tok_tristate et al except we have a temporary
+	   * conditional. (Sort of a hybrid tok_if, tok_tristate, tok_fi
+	   * option)
+	   */
+	  conditions[depth] = cfg->cond;
+	  depth++;
+	  cfg->cond = get_token_cond(&conditions[0], depth);
+	  depth--;
+	  free_condition(conditions[depth]);
+	  conditions[depth] = NULL;
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Fix any conditions involving the "choice" operator.
+   */
+  fix_choice_cond();
+
+  /*
+   * Walk through and see if there are multiple options that control the
+   * same kvariable.  If there are we need to treat them a little bit
+   * special.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch(cfg->tok)
+	{
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	  for(cfg1=cfg;cfg1 != NULL; cfg1 = cfg1->next)
+	    {
+	      switch(cfg1->tok)
+		{
+		case tok_define:
+		case tok_bool:
+		case tok_tristate:
+		case tok_dep_tristate:
+		case tok_int:
+		case tok_hex:
+		  if( strcmp(cfg->optionname, cfg1->optionname) == 0)
+		    {
+		      cfg->flags |= CFG_DUP;
+		      cfg1->flags |= CFG_DUP;
+		    }
+		  break;
+		default:
+		  break;
+		}
+	    }
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Now go through the list, and every time we see a kvariable, check
+   * to see whether it also has some dependencies.  If so, then
+   * append it to our list.  The reason we do this is that we might have
+   * option CONFIG_FOO which is only used if CONFIG_BAR is set.  It may
+   * turn out that in config.in that the default value for CONFIG_BAR is
+   * set to "y", but that CONFIG_BAR is not enabled because CONFIG_XYZZY
+   * is not set.  The current condition chain does not reflect this, but
+   * we can fix this by searching for the tokens that this option depends
+   * upon and cloning the conditions and merging them with the list.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Search for a token that has a condition list.
+       */
+      if(cfg->cond == NULL) continue;
+      for(cnd = cfg->cond; cnd; cnd=cnd->next)
+	{
+	  /*
+	   * Now search the condition list for a known configuration variable
+	   * that has conditions of its own.
+	   */
+	  if(cnd->op != op_kvariable) continue;
+	  if(cnd->variable.cfg->cond == NULL) continue;
+
+	  if(cnd->variable.cfg->flags & CFG_DUP) continue; 
+	  /*
+	   * OK, we have some conditions to append to cfg.  Make  a clone
+	   * of the conditions,
+	   */
+	  newcond = get_token_cond_frag(cnd->variable.cfg->cond, &last);
+
+	  /*
+	   * Finally, we splice it into our list.
+	   */
+	  last->next = cfg->cond;
+	  cfg->cond = newcond;
+
+	}
+    }
+
+  /*
+   * There is a strong possibility that we have duplicate conditions
+   * in here.  It would make the script more efficient and readable to
+   * remove these.  Here is where we assume here that there are no
+   * parenthesis in the input script.
+   */
+  for(cfg=scfg;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Search for configuration options that have conditions.
+       */
+      if(cfg->cond == NULL) continue;
+      for(cnd = cfg->cond; cnd; cnd=cnd->next)
+	{
+	  /*
+	   * Search for a left parenthesis.
+	   */
+	  if(cnd->op != op_lparen) continue;
+	  for(cnd1 = cnd->next; cnd1; cnd1=cnd1->next)
+	    {
+	      /*
+	       * Search after the previous left parenthesis, and try
+	       * and find a second left parenthesis.
+	       */
+	      if(cnd1->op != op_lparen) continue;
+
+	      /*
+	       * Now compare the next 5 tokens to see if they are
+	       * identical.  We are looking for two chains that
+	       * are like: '(' $VARIABLE operator constant ')'.
+	       */
+	      cnd2 = cnd;
+	      cnd3 = cnd1;
+	      for(i=0; i<5; i++, cnd2=cnd2->next, cnd3=cnd3->next)
+		{
+		  if(!cnd2 || !cnd3) break;
+		  if(cnd2->op != cnd3->op) break;
+		  if(i == 1 && (cnd2->op != op_kvariable 
+		     || cnd2->variable.cfg != cnd3->variable.cfg) ) break;
+		  if(i==2 && cnd2->op != op_eq && cnd2->op != op_neq) break;
+		  if(i == 3 && cnd2->op != op_constant &&
+		     strcmp(cnd2->variable.str, cnd3->variable.str) != 0)
+		    break;
+		  if(i==4 && cnd2->op != op_rparen) break;
+		}
+	      /*
+	       * If these match, and there is an and gluing these together,
+	       * then we can nuke the second one.
+	       */
+	      if(i==5 && ((cnd3 && cnd3->op == op_and)
+			  ||(cnd2 && cnd2->op == op_and)))
+		{
+		  /*
+		   * We have a duplicate.  Nuke 5 ops.
+		   */
+		  cnd3 = cnd1;
+		  for(i=0; i<5; i++, cnd3=cnd3->next)
+		    {
+		      cnd3->op = op_nuked;
+		    }
+		  /*
+		   * Nuke the and that glues the conditions together.
+		   */
+		  if(cnd3 && cnd3->op == op_and) cnd3->op = op_nuked;
+		  else if(cnd2 && cnd2->op == op_and) cnd2->op = op_nuked;
+		}
+	    }
+	}
+    }
+}
Index: vendors/IOIPSL/tools/tkgen.c
===================================================================
--- vendors/IOIPSL/tools/tkgen.c	(revision 9621)
+++ vendors/IOIPSL/tools/tkgen.c	(revision 9621)
@@ -0,0 +1,1136 @@
+/* Generate tk script based upon config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * 1996 01 04
+ * Avery Pennarun - Aesthetic improvements.
+ *
+ * 1996 01 24
+ * Avery Pennarun - Bugfixes and more aesthetics.
+ *
+ * 1996 03 08
+ * Avery Pennarun - The int and hex config.in commands work right.
+ *                - Choice buttons are more user-friendly.
+ *                - Disabling a text entry line greys it out properly.
+ *                - dep_tristate now works like in Configure. (not pretty)
+ *                - No warnings in gcc -Wall. (Fixed some "interesting" bugs.)
+ *                - Faster/prettier "Help" lookups.
+ *
+ * 1996 03 15
+ * Avery Pennarun - Added new sed script from Axel Boldt to make help even
+ *                  faster. (Actually awk is downright slow on some machines.)
+ *                - Fixed a bug I introduced into Choice dependencies.  Thanks
+ *                  to Robert Krawitz for pointing this out.
+ *
+ * 1996 03 16
+ * Avery Pennarun - basic "do_make" support added to let sound config work.
+ *
+ * 1996 03 25
+ *     Axel Boldt - Help now works on "choice" buttons.
+ *
+ * 1996 04 06
+ * Avery Pennarun - Improved sound config stuff. (I think it actually works
+ *                  now!)
+ *                - Window-resize-limits don't use ugly /usr/lib/tk4.0 hack.
+ *                - int/hex work with tk3 again. (The "cget" error.)
+ *                - Next/Prev buttons switch between menus.  I can't take
+ *                  much credit for this; the code was already there, but
+ *                  ifdef'd out for some reason.  It flickers a lot, but
+ *                  I suspect there's no "easy" fix for that.
+ *                - Labels no longer highlight as you move the mouse over
+ *                  them (although you can still press them... oh well.)
+ *                - Got rid of the last of the literal color settings, to
+ *                  help out people with mono X-Windows systems. 
+ *                  (Apparently there still are some out there!)
+ *                - Tabstops seem sensible now.
+ *
+ * 1996 04 14
+ * Avery Pennarun - Reduced flicker when creating windows, even with "update
+ *                  idletasks" hack.
+ *
+ * TO DO:
+ *   - clean up - there are useless ifdef's everywhere.
+ *   - better comments throughout - C code generating tcl is really cryptic.
+ *   - eliminate silly "update idletasks" hack to improve display speed and
+ *     reduce flicker.  But how?
+ *   - make canvas contents resize with the window (good luck).
+ *   - some way to make submenus inside of submenus (ie. Main->Networking->IP)
+ *           (perhaps a button where the description would be)
+ *   - make the main menu use the same tcl code as the submenus.
+ *   - make choice and int/hex input types line up vertically with
+ *           bool/tristate.
+ *   - general speedups - how?  The canvas seems to slow it down a lot.
+ *   - choice buttons should default to the first menu option, rather than a
+ *           blank.  Also look up the right variable when the help button
+ *           is pressed.
+ *   - clean up +/- 16 confusion for enabling/disabling variables; causes
+ *           (theoretical, at the moment) problems with dependencies.
+ *   
+ */
+#include <stdio.h>
+#include <unistd.h>
+#include "tkparse.h"
+
+#ifndef TRUE
+#define TRUE (1)
+#endif
+
+#ifndef FALSE
+#define FALSE (0)
+#endif
+
+/*
+ * This is the total number of submenus that we have.
+ */
+static int tot_menu_num =0;
+
+/*
+ * Generate portion of wish script for the beginning of a submenu.
+ * The guts get filled in with the various options.
+ */
+static void start_proc(char * label, int menu_num, int flag)
+{
+  if( flag )
+    printf("menu_option menu%d %d \"%s\"\n", menu_num, menu_num, label);
+  printf("proc menu%d {w title} {\n", menu_num);
+  printf("\tcatch {destroy $w}\n");
+  printf("\ttoplevel $w -class Dialog\n");
+  printf("\twm withdraw $w\n");
+  printf("\tmessage $w.m -width 400 -aspect 300 -text \\\n");
+  printf("\t\t\"%s\"  -relief raised\n",label);
+  printf("\tpack $w.m -pady 10 -side top -padx 10\n");
+  printf("\twm title $w \"%s\" \n\n", label);
+  
+  /*
+   * Attach the "Prev", "Next" and "OK" buttons at the end of the window.
+   */
+  printf("\tset oldFocus [focus]\n");
+  printf("\tframe $w.f\n");
+  printf("\tbutton $w.f.back -text \"Main Menu\" \\\n"
+         "\t\t-width 15 -command \"destroy $w; focus $oldFocus; update_mainmenu $w\"\n");
+  printf("\tbutton $w.f.next -text \"Next\" \\\n"
+         "\t\t-width 15 -command \" destroy $w; focus $oldFocus;  menu%d .menu%d \\\"$title\\\"\"\n",
+         	menu_num+1, menu_num+1);
+  if (menu_num == tot_menu_num)
+  	printf("\t$w.f.next configure -state disabled\n");
+  printf("\tbutton $w.f.prev -text \"Prev\" \\\n"
+         "\t\t-width 15 -command \" destroy $w; focus $oldFocus; menu%d .menu%d \\\"$title\\\"\"\n",
+       		menu_num-1, menu_num-1);
+  if (1 == menu_num)
+  	printf("\t$w.f.prev configure -state disabled\n");
+  printf("\tpack $w.f.back $w.f.next $w.f.prev -side left -expand on\n");
+  printf("\tpack $w.f -pady 10 -side bottom -anchor w -fill x\n");
+
+  /*
+   * Lines between canvas and other areas of the window.
+   */
+  printf("\tframe $w.topline -relief ridge -borderwidth 2 -height 2\n");
+  printf("\tpack $w.topline -side top -fill x\n\n");
+  printf("\tframe $w.botline -relief ridge -borderwidth 2 -height 2\n");
+  printf("\tpack $w.botline -side bottom -fill x\n\n");
+  
+  /*
+   * The "config" frame contains the canvas and a scrollbar.
+   */
+  printf("\tframe $w.config\n");
+  printf("\tpack $w.config -fill y -expand on\n\n");
+  printf("\tscrollbar $w.config.vscroll -command \"$w.config.canvas yview\"\n");
+  printf("\tpack $w.config.vscroll -side right -fill y\n\n");
+  
+  /*
+   * The scrollable canvas itself, where the real work (and mess) gets done.
+   */
+  printf("\tcanvas $w.config.canvas -height 1\\\n"
+  	 "\t\t-relief flat -borderwidth 0 -yscrollcommand \"$w.config.vscroll set\" \\\n"
+  	 "\t\t-width [expr [winfo screenwidth .] * 1 / 2] \n");
+  printf("\tframe $w.config.f\n");
+  printf("\tpack $w.config.canvas -side right -fill y\n");
+  
+  printf("\n\n");
+}
+
+/*
+ * Each proc we create needs a global declaration for any global variables we
+ * use.  To minimize the size of the file, we set a flag each time we output
+ * a global declaration so we know whether we need to insert one for a
+ * given function or not.
+ */
+void clear_globalflags(struct kconfig * cfg)
+{
+  for(; cfg != NULL; cfg = cfg->next)
+  {
+    cfg->flags &= ~GLOBAL_WRITTEN;
+  }
+}
+
+/*
+ * Output a "global" line for a given variable.  Also include the
+ * call to "vfix".  (If vfix is not needed, then it's fine to just printf
+ * a "global" line).
+ */
+void global(char *var)
+{
+  printf("\tglobal %s; vfix %s\n", var, var);
+}
+
+/*
+ * This function walks the chain of conditions that we got from cond.c,
+ * and creates a wish conditional to enable/disable a given widget.
+ */
+void generate_if(struct kconfig * item,
+	    struct condition * cond,
+	    int menu_num,
+	    int line_num)
+{
+  struct condition * ocond;
+
+  ocond = cond;
+
+  /*
+   * First write any global declarations we need for this conditional.
+   */
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_variable:
+      	global(cond->variable.str);
+	break;
+      case op_kvariable:
+	if(cond->variable.cfg->flags & GLOBAL_WRITTEN) break;
+	cond->variable.cfg->flags |= GLOBAL_WRITTEN;
+	global(cond->variable.cfg->optionname);
+	break;
+      default:
+	break;
+      }
+      cond = cond->next;
+    }
+  
+  /*
+   * Now write this option.
+   */
+  if(   (item->flags & GLOBAL_WRITTEN) == 0
+     && (item->optionname != NULL) )
+    {
+      global(item->optionname);
+      item->flags |= GLOBAL_WRITTEN;
+    }
+  /*
+   * Now generate the body of the conditional.
+   */
+  printf("\tif {");
+  cond = ocond;
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_eq:
+	printf(" == ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+      case op_and1:
+	printf(" && ");
+	break;
+      case op_or:
+	printf(" || ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_kvariable:
+	printf("$%s", cond->variable.cfg->optionname);
+	break;
+      case op_shellcmd:
+	printf("[exec %s]", cond->variable.str);
+	break;
+      case op_constant:
+	if( strcmp(cond->variable.str, "y") == 0 )
+	  printf("1");
+	else if( strcmp(cond->variable.str, "n") == 0 )
+	  printf("0");
+	else if( strcmp(cond->variable.str, "m") == 0 )
+	  printf("2");
+	else
+	  printf("\"%s\"", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  /*
+   * Now we generate what we do depending upon the value of the conditional.
+   * Depending upon what the token type is, there are different things
+   * we must do to enable/disable the given widget - this code needs to
+   * be closely coordinated with the widget creation procedures in header.tk.
+   */
+  switch(item->tok)
+    {
+    case tok_define:
+      printf("} then { set %s %s } \n",  item->optionname, item->value);
+      break;
+    case tok_menuoption:
+      printf("} then { .f0.x%d configure -state normal } else { .f0.x%d configure -state disabled }\n",
+	     menu_num, menu_num);
+      break;
+    case tok_int:
+    case tok_hex:
+      printf("} then { ");
+      printf(".menu%d.config.f.x%d.x configure -state normal -fore [ cget .ref -foreground ]; ", menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal; ", menu_num, line_num);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.x configure -state disabled -fore [ cget .ref -disabledforeground ];", menu_num, line_num );
+      printf(".menu%d.config.f.x%d.l configure -state disabled;", menu_num, line_num );
+      printf("}\n");
+      break;
+    case tok_bool:
+#ifdef BOOL_IS_BUTTON
+      /*
+       * If a bool is just a button, then use this definition.
+       */
+      printf("} then { .menu%d.config.f.x%d configure -state normal } else { .menu%d.config.f.x%d configure -state disabled }\n",
+	     menu_num, line_num,
+	     menu_num, line_num );
+#else
+      /*
+       * If a bool is a radiobutton, then use this instead.
+       */
+      printf("} then { ");
+      printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal;",menu_num, line_num);
+      printf("set %s [expr $%s&15];", item->optionname, item->optionname);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state disabled;",menu_num, line_num);
+      printf("set %s [expr $%s|16];", item->optionname, item->optionname);
+      printf("}\n");
+#endif
+      break;
+    case tok_tristate:
+    case tok_dep_tristate:
+      printf("} then { ");
+      if( item->tok == tok_dep_tristate )
+	{
+	  global(item->depend.str);
+	  printf("if { $%s != 1 && $%s != 0 } then {", 
+	  	item->depend.str,item->depend.str);
+	  printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+	  printf("} else {");
+	  printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+	  printf("}; ");
+	}
+      else
+	{
+	  printf(".menu%d.config.f.x%d.y configure -state normal;",menu_num, line_num);
+	}
+      
+      printf(".menu%d.config.f.x%d.n configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.m configure -state normal;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state normal;",menu_num, line_num);
+      /*
+       * Or in a bit to the variable - this causes all of the radiobuttons
+       * to be deselected (i.e. not be red).
+       */
+      printf("set %s [expr $%s&15];", item->optionname, item->optionname);
+      printf("} else { ");
+      printf(".menu%d.config.f.x%d.y configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.n configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.m configure -state disabled;",menu_num, line_num);
+      printf(".menu%d.config.f.x%d.l configure -state disabled;",menu_num, line_num);
+      /*
+       * Clear the disable bit - this causes the correct radiobutton
+       * to appear selected (i.e. turn red).
+       */
+      printf("set %s [expr $%s|16];", item->optionname, item->optionname);
+      printf("}\n");
+      break;
+    case tok_choose:
+    case tok_choice:
+      fprintf(stderr,"Fixme\n");
+      exit(0);
+    default:
+      break;
+    }
+}
+
+/*
+ * Similar to generate_if, except we come here when generating an
+ * output file.  Thus instead of enabling/disabling a widget, we
+ * need to decide whether to write out a given configuration variable
+ * to the output file.
+ */
+void generate_if_for_outfile(struct kconfig * item,
+	    struct condition * cond)
+{
+  struct condition * ocond;
+
+  /*
+   * First write any global declarations we need for this conditional.
+   */
+  ocond = cond;
+  for(; cond != NULL; cond = cond->next )
+    {
+      switch(cond->op){
+      case op_variable:
+        global(cond->variable.str);
+	break;
+      case op_kvariable:
+	if(cond->variable.cfg->flags & GLOBAL_WRITTEN) break;
+	cond->variable.cfg->flags |= GLOBAL_WRITTEN;
+	global(cond->variable.cfg->optionname);
+	break;
+      default:
+	break;
+      }
+    }
+
+  /*
+   * Now generate the body of the conditional.
+   */
+  printf("\tif {");
+  cond = ocond;
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_eq:
+	printf(" == ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+      case op_and1:
+	printf(" && ");
+	break;
+      case op_or:
+	printf(" || ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_shellcmd:
+	printf("[exec %s]", cond->variable.str);
+	break;
+      case op_kvariable:
+	printf("$%s", cond->variable.cfg->optionname);
+	break;
+      case op_constant:
+	if( strcmp(cond->variable.str, "y") == 0 )
+	  printf("1");
+	else if( strcmp(cond->variable.str, "n") == 0 )
+	  printf("0");
+	else if( strcmp(cond->variable.str, "m") == 0 )
+	  printf("2");
+	else
+	  printf("\"%s\"", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  /*
+   * Now we generate what we do depending upon the value of the
+   * conditional.  Depending upon what the token type is, there are
+   * different things we must do write the value the given widget -
+   * this code needs to be closely coordinated with the widget
+   * creation procedures in header.tk.  
+   */
+  switch(item->tok)
+    {
+    case tok_define:
+      printf("} then {write_tristate $cfg $autocfg %s %s $notmod }\n", item->optionname, item->value);
+      break;
+    case tok_comment:
+      printf("} then {write_comment $cfg $autocfg \"%s\"}\n", item->label);
+      break;
+    case tok_dep_tristate:
+      printf("} then { write_tristate $cfg $autocfg %s $%s $%s } \n", 
+	     item->optionname, item->optionname, item->depend.str);
+      break;
+    case tok_tristate:
+    case tok_bool:
+      printf("} then { write_tristate $cfg $autocfg %s $%s $notmod }\n", 
+	     item->optionname, item->optionname);
+      break;
+    case tok_int:
+      printf("} then { write_int $cfg $autocfg %s $%s $notmod }\n",
+             item->optionname, item->optionname);
+      break;
+    case tok_hex:
+      printf("} then { write_hex $cfg $autocfg %s $%s $notmod }\n",
+             item->optionname, item->optionname);
+      break;
+    case tok_make:
+      printf("} then { do_make {%s} }\n",item->value);
+      break;
+    case tok_choose:
+    case tok_choice:
+      fprintf(stderr,"Fixme\n");
+      exit(0);
+    default:
+      break;
+    }
+}
+
+/*
+ * Generates a fragment of wish script that closes out a submenu procedure.
+ */
+static void end_proc(int menu_num)
+{
+  struct kconfig * cfg;
+
+  printf("\n\n\n");
+  printf("\tfocus $w\n");
+  printf("\tupdate_menu%d $w.config.f\n", menu_num);
+  printf("\tglobal winx; global winy\n");
+  printf("\tset winx [expr [winfo x .]+30]; set winy [expr [winfo y .]+30]\n");
+  printf("\twm geometry $w +$winx+$winy\n");
+  
+  /*
+   * Now that the whole window is in place, we need to wait for an "update"
+   * so we can tell the canvas what its virtual size should be.
+   *
+   * Unfortunately, this causes some ugly screen-flashing because the whole
+   * window is drawn, and then it is immediately resized.  It seems
+   * unavoidable, though, since "frame" objects won't tell us their size
+   * until after an update, and "canvas" objects can't automatically pack
+   * around frames.  Sigh.
+   */
+  printf("\tupdate idletasks\n");
+  printf("\t$w.config.canvas create window 0 0 -anchor nw -window $w.config.f\n\n");
+  printf("\t$w.config.canvas configure \\\n"
+  	 "\t\t-width [expr [winfo reqwidth $w.config.f] + 1]\\\n"
+  	 "\t\t-scrollregion \"-1 -1 [expr [winfo reqwidth $w.config.f] + 1] \\\n"
+  	 "\t\t\t [expr [winfo reqheight $w.config.f] + 1]\"\n\n");
+  	 
+  /*
+   * If the whole canvas will fit in 3/4 of the screen height, do it;
+   * otherwise, resize to around 1/2 the screen and let us scroll.
+   */
+  printf("\tset winy [expr [winfo reqh $w] - [winfo reqh $w.config.canvas]]\n");
+  printf("\tset scry [expr [winfo screenh $w] / 2]\n");
+  printf("\tset maxy [expr [winfo screenh $w] * 3 / 4]\n");
+  printf("\tset canvtotal [expr [winfo reqh $w.config.f] + 2]\n");
+  printf("\tif [expr $winy + $canvtotal < $maxy] {\n"
+  	 "\t\t$w.config.canvas configure -height $canvtotal\n"
+  	 "\t} else {\n"
+  	 "\t\t$w.config.canvas configure -height [expr $scry - $winy]\n"
+  	 "\t}\n");
+  
+  /*
+   * Limit the min/max window size.  Height can vary, but not width,
+   * because of the limitations of canvas and our laziness.
+   */
+  printf("\tupdate idletasks\n");
+  printf("\twm maxsize $w [winfo width $w] [winfo screenheight $w]\n");
+  printf("\twm minsize $w [winfo width $w] 100\n\n");
+  printf("\twm deiconify $w\n");
+    
+  printf("}\n\n\n");
+
+  /*
+   * Now we generate the companion procedure for the menu we just
+   * generated.  This procedure contains all of the code to
+   * disable/enable widgets based upon the settings of the other
+   * widgets, and will be called first when the window is mapped,
+   * and each time one of the buttons in the window are clicked.
+   */
+  printf("proc update_menu%d {w}  {\n", menu_num);
+
+  printf("\tupdate_define\n");
+  clear_globalflags(config);
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if (cfg->menu_number != menu_num ) continue;
+      if (cfg->tok != tok_define) continue;
+      /*
+       * Clear all of the booleans that are defined in this menu.
+       */
+      if(   (cfg->flags & GLOBAL_WRITTEN) == 0
+	 && (cfg->optionname != NULL) )
+	{
+	  printf("\tglobal %s\n", cfg->optionname);
+	  cfg->flags |= GLOBAL_WRITTEN;
+	  printf("\tset %s 0\n", cfg->optionname);
+	}
+
+    }
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if (cfg->menu_number != menu_num ) continue;
+      if (cfg->tok == tok_menuoption) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, menu_num, cfg->menu_line);
+      else
+	{
+	  /*
+	   * If this token has no conditionals, check to see whether
+	   * it is a tristate - if so, then generate the conditional
+	   * to enable/disable the "y" button based upon the setting
+	   * of the option it depends upon.
+	   */
+	  if(cfg->tok == tok_dep_tristate)
+	    {
+	      global(cfg->depend.str);
+	      printf("\tif {$%s != 1 && $%s != 0 } then { .menu%d.config.f.x%d.y configure -state disabled } else { .menu%d.config.f.x%d.y configure -state normal}\n",
+		     cfg->depend.str,cfg->depend.str,
+		     menu_num, cfg->menu_line,
+		     menu_num, cfg->menu_line);
+	    }
+	}
+
+    }
+
+
+  printf("}\n\n\n");
+}
+
+/*
+ * This function goes through and counts up the number of items in
+ * each submenu. If there are too many options, we need to split it
+ * into submenus.  This function just calculates how many submenus,
+ * and how many items go in each submenu.
+ */
+static void find_menu_size(struct kconfig *cfg,
+			  int *menu_max, 
+			  int *menu_maxlines)
+
+{
+  struct kconfig * pnt;
+  int tot;
+  
+  /*
+   * First count up the number of options in this menu.
+   */
+  tot = 0;
+  for(pnt = cfg->next; pnt; pnt = pnt->next)
+  {
+    if( pnt->tok == tok_menuoption) break;
+    switch (pnt->tok)
+      {
+      case tok_bool:
+      case tok_tristate:
+      case tok_dep_tristate:
+      case tok_int:
+      case tok_hex:
+      case tok_choose:
+	tot++;
+	break;
+      case tok_choice:
+      default:
+	break;
+      }
+  }
+
+  *menu_max = cfg->menu_number;
+  *menu_maxlines = tot;
+}
+
+/*
+ * This is the top level function for generating the tk script.
+ */
+void dump_tk_script(struct kconfig *scfg)
+{
+  int menu_num =0;
+  int menu_max =0;
+  int menu_min =0;
+  int menu_line = 0;
+  int menu_maxlines = 0;
+  struct kconfig * cfg;
+  struct kconfig * cfg1 = NULL;
+  char * menulabel;
+
+  /*
+   * Start by assigning menu numbers, and submenu numbers.
+   */
+  for(cfg = scfg;cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuname:
+	  break;
+	case tok_menuoption:
+	  /*
+	   * At the start of a new menu, calculate the number of items
+	   * we will put into each submenu so we know when to bump the
+	   * menu number. The submenus are really no different from a
+	   * normal menu, but the top level buttons only access the first
+	   * of the chain of menus, and the prev/next buttons are used
+	   * access the submenus.
+	   */
+	  cfg->menu_number = ++menu_num;
+	  find_menu_size(cfg, &menu_max, &menu_maxlines);
+	  cfg->submenu_start = menu_num;
+	  cfg->submenu_end = menu_max;
+	  menu_line = 0;
+	  break;
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	case tok_choose:
+	  /*
+	   * If we have overfilled the menu, then go to the next one.
+	   */
+	  if( menu_line == menu_maxlines )
+	    {
+	      menu_line = 0;
+	      menu_num++;
+	    }
+	  cfg->menu_number = menu_num;
+	  cfg->submenu_start = menu_min;
+	  cfg->submenu_end = menu_max;
+	  cfg->menu_line = menu_line++;
+	  break;
+	case tok_define:
+	  cfg->menu_number = -1;
+	case tok_choice:
+	default:
+	  break;
+	};
+    }
+
+  /*
+   * Record this so we can set up the prev/next buttons correctly.
+   */
+  tot_menu_num = menu_num;
+
+  /*
+   * Now start generating the actual wish script that we will use.
+   * We need to keep track of the menu numbers of the min/max menu
+   * for a range of submenus so that we can correctly limit the
+   * prev and next buttons so that they don't go over into some other
+   * category.
+   */
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuname:
+	  printf("mainmenu_name \"%s\"\n", cfg->label);
+	  break;
+	case tok_menuoption:
+	  /*
+	   * We are at the start of a new menu. If we had one that
+	   * we were working on before, close it out, and then generate
+	   * the script to start the new one.
+	   */
+	  if( cfg->menu_number > 1 )
+	    {
+	      end_proc(menu_num);
+	    }
+	  menulabel = cfg->label;
+	  start_proc(cfg->label, cfg->menu_number, TRUE);
+	  menu_num = cfg->menu_number;
+	  menu_max = cfg->submenu_end;
+	  menu_min = cfg->submenu_start;
+	  break;
+	case tok_bool:
+	  /*
+	   * If we reached the point where we need to switch over
+	   * to the next submenu, then bump the menu number and generate
+	   * the code to close out the old menu and start the new one.
+	   */
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tbool $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+
+	case tok_choice:
+	  printf("\t$w.config.f.x%d.x.menu add radiobutton -label \"%s\" -variable %s -value \"%s\" -command \"update_menu%d .menu%d.config.f\"\n",
+		 cfg1->menu_line,
+		 cfg->label,
+		 cfg1->optionname,
+		 cfg->label,
+		 cfg1->menu_number, cfg1->menu_number);
+	  break;
+	case tok_choose:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tglobal %s\n",cfg->optionname);
+	  printf("\tminimenu $w.config.f %d %d \"%s\" %s %s\n",
+	  	cfg->menu_number,
+	  	cfg->menu_line,
+	  	cfg->label,
+	  	cfg->optionname,
+	  	/*
+	  	 * We rely on the fact that the first tok_choice corresponding
+	  	 * to the current tok_choose is cfg->next (compare parse() in
+	  	 * tkparse.c).  We need its name to pick out the right help
+	  	 * text from Configure.help.
+	  	 */
+	  	cfg->next->optionname);
+	  printf("\tmenu $w.config.f.x%d.x.menu\n", cfg->menu_line);
+	  cfg1 = cfg;
+	  break;
+	case tok_tristate:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\ttristate $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	case tok_dep_tristate:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tdep_tristate $w.config.f %d %d \"%s\" %s %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname,
+		 cfg->depend.str);
+	  break;
+	case tok_int:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\tint $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	case tok_hex:
+	  if( cfg->menu_number != menu_num )
+	    {
+	      end_proc(menu_num);
+	      start_proc(menulabel, cfg->menu_number, FALSE);
+	      menu_num = cfg->menu_number;
+	    }
+	  printf("\thex $w.config.f %d %d \"%s\" %s\n",
+		 cfg->menu_number,
+		 cfg->menu_line,
+		 cfg->label,
+		 cfg->optionname);
+	  break;
+	default:
+	  break;
+	}
+
+    }
+
+  /*
+   * Generate the code to close out the last menu.
+   */
+  end_proc(menu_num);
+
+#ifdef ERIC_DONT_DEF
+  /*
+   * Generate the code for configuring the sound driver.  Right now this
+   * cannot be done from the X script, but we insert the menu anyways.
+   */
+  start_proc("Configure sound driver", ++menu_num, TRUE);
+#if 0
+  printf("\tdo_make -C drivers/sound config\n");
+  printf("\techo check_sound_config %d\n",menu_num);
+#endif
+  printf("\tlabel $w.config.f.m0 -bitmap error\n");
+  printf("\tmessage $w.config.f.m1 -width 400 -aspect 300 -text \"The sound drivers cannot as of yet be configured via the X-based interface\" -relief raised\n");
+  printf("\tpack $w.config.f.m0 $w.config.f.m1 -side top -pady 10 -expand on\n");
+  /*
+   * Close out the last menu.
+   */
+  end_proc(menu_num);
+#endif
+
+  /*
+   * The top level menu also needs an update function.  When we exit a
+   * submenu, we may need to disable one or more of the submenus on
+   * the top level menu, and this procedure will ensure that things are
+   * correct.
+   */
+  printf("proc update_mainmenu {w}  {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_menuoption:
+	  if (cfg->cond != NULL ) 
+	    generate_if(cfg, cfg->cond, cfg->menu_number, cfg->menu_line);
+	  break;
+	default:
+	  break;
+	}
+    }
+
+  printf("}\n\n\n");
+
+#if 0
+  /*
+   * Generate some code to set the variables that are "defined".
+   */
+  for(cfg = config;cfg != NULL; cfg = cfg->next)
+    {
+      /*
+       * Skip items not for this menu, or ones having no conditions.
+       */
+      if( cfg->tok != tok_define) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, menu_num, cfg->menu_line);
+      else
+	{
+	  printf("\twrite_define %s %s\n", cfg->optionname, cfg->value);
+	}
+
+    }
+#endif
+
+  /*
+   * Now generate code to load the default settings into the variables.
+   * Note that the script in tail.tk will attempt to load .config,
+   * which may override these settings, but that's OK.
+   */
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_choice:
+	  printf("set %s 0\n", cfg->optionname);
+	  break;
+	case tok_int:
+	case tok_hex:
+	  printf("set %s %s\n", cfg->optionname, cfg->value);
+	  break;
+	case tok_choose:
+	  printf("set %s \"(not set)\"\n",cfg->optionname);
+	default:
+	  break;
+	}
+    }
+
+  /*
+   * Next generate a function that can be called from the main menu that will
+   * write all of the variables out.  This also serves double duty - we can
+   * save configuration to a file using this.
+   */
+  printf("proc writeconfig {file1 file2} {\n");
+  printf("\tset cfg [open $file1 w]\n");
+  printf("\tset autocfg [open $file2 w]\n");
+  printf("\tset notmod 1\n");
+  printf("\tset notset 0\n");
+  clear_globalflags(config);
+  printf("\tputs $cfg \"#\"\n");
+  printf("\tputs $cfg \"# Automatically generated make config: don't edit\"\n");
+  printf("\tputs $cfg \"#\"\n");
+
+  printf("\tputs $autocfg \"/*\"\n");
+  printf("\tputs $autocfg \" * Automatically generated C config: don't edit\"\n");
+  printf("\tputs $autocfg \" */\"\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      switch (cfg->tok)
+	{
+	case tok_int:
+	case tok_hex:
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_define:
+	case tok_choose:
+	  if(!(cfg->flags & GLOBAL_WRITTEN))
+	    {
+	      cfg->flags |= GLOBAL_WRITTEN;
+	      printf("\tglobal %s\n", cfg->optionname);
+	    }
+	  /* fall through */
+	case tok_make:
+	case tok_comment:
+	  if (cfg->cond != NULL ) 
+	    generate_if_for_outfile(cfg, cfg->cond);
+	  else
+	    {
+	      if(cfg->tok == tok_dep_tristate)
+		{
+		  printf("\tif {$%s == 0 } then {\n"
+		  	 "\t\twrite_tristate $cfg $autocfg %s $notset $notmod\n"
+		  	 "\t} else {\n"
+		  	 "\t\twrite_tristate $cfg $autocfg %s $%s $%s\n"
+		  	 "\t}\n",
+		  	 cfg->depend.str,
+			 cfg->optionname,
+			 cfg->optionname,
+			 cfg->optionname,
+			 cfg->depend.str);
+		}
+	      else if(cfg->tok == tok_comment)
+		{
+		  printf("\twrite_comment $cfg $autocfg \"%s\"\n", cfg->label);
+		}
+#if 0
+	      else if(cfg->tok == tok_define)
+		{
+		  printf("\twrite_define %s %s\n", cfg->optionname,
+			 cfg->value);
+		}
+#endif
+	      else if (cfg->tok == tok_choose )
+		{
+		  for(cfg1 = cfg->next; 
+		      cfg1 != NULL && cfg1->tok == tok_choice;
+		      cfg1 = cfg1->next)
+		    {
+		      printf("\tif { $%s == \"%s\" } then { write_tristate $cfg $autocfg %s 1 $notmod }\n",
+			     cfg->optionname,
+			     cfg1->label,
+			     cfg1->optionname);
+		    }
+		}
+	      else if (cfg->tok == tok_int )
+	        {
+		  printf("\twrite_int $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+	        }
+	      else if (cfg->tok == tok_hex )
+	        {
+		  printf("\twrite_hex $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+	        }
+	      else if (cfg->tok == tok_make )
+	        {
+	          printf("\tdo_make {%s}\n",cfg->value);
+	        }
+	      else
+		{
+		  printf("\twrite_tristate $cfg $autocfg %s $%s $notmod\n",
+			 cfg->optionname,
+			 cfg->optionname);
+		}
+	    }
+	  break;
+	default:
+	  break;
+	}
+    }
+  printf("\tclose $cfg\n");
+  printf("\tclose $autocfg\n");
+  printf("}\n\n\n");
+
+  /*
+   * Finally write a simple function that updates the master choice
+   * variable depending upon what values were loaded from a .config
+   * file.  
+   */
+  printf("proc clear_choices { } {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_choose ) continue;
+      for(cfg1 = cfg->next; 
+	  cfg1 != NULL && cfg1->tok == tok_choice;
+	  cfg1 = cfg1->next)
+	{
+	  printf("\tglobal %s; set %s 0\n",cfg1->optionname,cfg1->optionname);
+	}
+    }
+  printf("}\n\n\n");
+
+  printf("proc update_choices { } {\n");
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_choose ) continue;
+      printf("\tglobal %s\n", cfg->optionname);
+      for(cfg1 = cfg->next; 
+	  cfg1 != NULL && cfg1->tok == tok_choice;
+	  cfg1 = cfg1->next)
+	{
+	  printf("\tglobal %s\n", cfg1->optionname);
+	  printf("\tif { $%s == 1 } then { set %s \"%s\" }\n",
+		 cfg1->optionname,
+		 cfg->optionname,
+		 cfg1->label);
+	}
+    }
+  printf("}\n\n\n");
+
+  printf("proc update_define { } {\n");
+  clear_globalflags(config);
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_define ) continue;
+      printf("\tglobal %s; set %s 0\n",  cfg->optionname,  cfg->optionname);
+      cfg->flags |= GLOBAL_WRITTEN;
+    }
+  for(cfg = scfg; cfg != NULL; cfg = cfg->next)
+    {
+      if( cfg->tok != tok_define ) continue;
+      if (cfg->cond != NULL ) 
+	generate_if(cfg, cfg->cond, -1, 0);
+      else
+	{
+	  printf("\tset %s %s\n",
+		 cfg->optionname, cfg->value);
+	}
+    }
+  printf("}\n\n\n");
+  /*
+   * That's it.  We are done.  The output of this file will have header.tk
+   * prepended and tail.tk appended to create an executable wish script.
+   */
+}
Index: vendors/IOIPSL/tools/tkparse.c
===================================================================
--- vendors/IOIPSL/tools/tkparse.c	(revision 9621)
+++ vendors/IOIPSL/tools/tkparse.c	(revision 9621)
@@ -0,0 +1,755 @@
+/* parser config.in
+ * $Id$
+ *
+ * This software is governed by the CeCILL license
+ * See IOIPSL/IOIPSL_License_CeCILL.txt
+ *
+ * Version 1.0
+ * Eric Youngdale
+ * 10/95
+ *
+ * The general idea here is that we want to parse a config.in file and 
+ * from this, we generate a wish script which gives us effectively the
+ * same functionality that the original config.in script provided.
+ *
+ * This task is split roughly into 3 parts.  The first parse is the parse
+ * of the input file itself.  The second part is where we analyze the 
+ * #ifdef clauses, and attach a linked list of tokens to each of the
+ * menu items.  In this way, each menu item has a complete list of
+ * dependencies that are used to enable/disable the options.
+ * The third part is to take the configuration database we have build,
+ * and build the actual wish script.
+ *
+ * This file contains the code to do the first parse of config.in.
+ */
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "tkparse.h"
+
+struct kconfig * config = NULL;
+struct kconfig * clast = NULL;
+struct kconfig * koption = NULL;
+static int lineno = 0;
+static int menus_seen = 0;
+static char * current_file = NULL;
+static int do_source(char * filename);
+static char * get_string(char *pnt, char ** labl);
+static int choose_number = 0;
+
+
+/*
+ * Simple function just to skip over spaces and tabs in config.in.
+ */
+static char * skip_whitespace(char * pnt)
+{
+  while( *pnt && (*pnt == ' ' || *pnt == '\t')) pnt++;
+  return pnt;
+}
+
+/*
+ * This function parses a conditional from a config.in (i.e. from an ifdef)
+ * and generates a linked list of tokens that describes the conditional.
+ */
+static struct condition * parse_if(char * pnt)
+{
+  char * opnt;
+  struct condition *list;
+  struct condition *last;
+  struct condition *cpnt;
+  char varname[64];
+  char * pnt1;
+
+  opnt = pnt;
+
+  /*
+   * We need to find the various tokens, and build the linked list.
+   */
+  pnt = skip_whitespace(pnt);
+  if( *pnt != '[' ) return NULL;
+  pnt++;
+  pnt = skip_whitespace(pnt);
+
+  list = last = NULL;
+  while(*pnt && *pnt != ']') {
+
+    pnt = skip_whitespace(pnt);
+    if(*pnt== '\0' || *pnt == ']') break;
+
+    /*
+     * Allocate memory for the token we are about to parse, and insert
+     * it in the linked list.
+     */
+    cpnt = (struct condition *) malloc(sizeof(struct condition));
+    memset(cpnt, 0, sizeof(struct condition));
+    if( last == NULL )
+      {
+	list = last = cpnt;
+      }
+    else
+      {
+	last->next = cpnt;
+	last = cpnt;
+      }
+
+    /*
+     * Determine what type of operation this token represents.
+     */
+    if( *pnt == '-' && pnt[1] == 'a' )
+      {
+	cpnt->op = op_and;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '-' && pnt[1] == 'o' )
+      {
+	cpnt->op = op_or;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '!' && pnt[1] == '=' )
+      {
+	cpnt->op = op_neq;
+	pnt += 2;
+	continue;
+      }
+
+    if( *pnt == '=')
+      {
+	cpnt->op = op_eq;
+	pnt += 1;
+	continue;
+      }
+
+    if( *pnt == '!')
+      {
+	cpnt->op = op_bang;
+	pnt += 1;
+	continue;
+      }
+
+    if( *pnt != '"' ) goto error;  /* This cannot be right. */
+    pnt++;
+    if( *pnt == '`' )
+      {
+	cpnt->op = op_shellcmd;
+	pnt1 = varname;
+	pnt++;
+	while(*pnt && *pnt != '`') *pnt1++ = *pnt++;
+	*pnt1++ = '\0';
+	cpnt->variable.str = strdup(varname);
+	if( *pnt == '`' ) pnt++;
+	if( *pnt == '"' ) pnt++;
+	continue;
+      }
+    if( *pnt == '$' )
+      {
+	cpnt->op = op_variable;
+	pnt1 = varname;
+	pnt++;
+	while(*pnt && *pnt != '"') *pnt1++ = *pnt++;
+	*pnt1++ = '\0';
+	cpnt->variable.str = strdup(varname);
+	if( *pnt == '"' ) pnt++;
+	continue;
+      }
+
+    cpnt->op = op_constant;
+    pnt1 = varname;
+    while(*pnt && *pnt != '"') *pnt1++ = *pnt++;
+    *pnt1++ = '\0';
+    cpnt->variable.str = strdup(varname);
+    if( *pnt == '"' ) pnt++;
+    continue;
+  }
+
+  return list;
+
+ error:
+  if(current_file != NULL) 
+    fprintf(stderr, 
+	    "Bad if clause at line %d(%s):%s\n", lineno, current_file, opnt);
+  else
+    fprintf(stderr,
+	    "Bad if clause at line %d:%s\n", lineno, opnt);
+  return NULL;
+}
+
+/*
+ * This function looks for a quoted string, from the input buffer, and
+ * returns a pointer to a copy of this string.  Any characters in
+ * the string that need to be "quoted" have a '\' character inserted
+ * in front - this way we can directly write these strings into
+ * wish scripts.
+ */
+static char * get_qstring(char *pnt, char ** labl)
+{
+  char quotechar;
+  char newlabel[1024];
+  char * pnt1;
+  char * pnt2;
+
+  while( *pnt && *pnt != '"' && *pnt != '\'') pnt++;
+  if (*pnt == '\0') return pnt;
+
+  quotechar = *pnt++;
+  pnt1 = newlabel;
+  while(*pnt && *pnt != quotechar && pnt[-1] != '\\')
+    {
+      /*
+       * Quote the character if we need to.
+       */
+      if( *pnt == '"' || *pnt == '\'' || *pnt == '[' || *pnt == ']')
+	*pnt1++ = '\\';
+
+      *pnt1++ = *pnt++;
+    }
+  *pnt1++ = '\0';
+
+  pnt2 = (char *) malloc(strlen(newlabel) + 1);
+  strcpy(pnt2, newlabel);
+  *labl = pnt2;
+
+  /*
+   * Skip over last quote, and whitespace.
+   */
+  pnt++;
+  pnt = skip_whitespace(pnt);
+  return pnt;
+}
+
+static char * parse_choices(struct kconfig * choice_kcfg, char * pnt)
+{
+  struct kconfig * kcfg;
+  int index = 1;
+
+  /*
+   * Choices appear in pairs of strings.  The parse is fairly trivial.
+   */
+  while(1)
+    {
+      pnt = skip_whitespace(pnt);
+      if(*pnt == '\0') break;
+
+      kcfg = (struct kconfig *) malloc(sizeof(struct kconfig));
+      memset(kcfg, 0, sizeof(struct kconfig));
+      kcfg->tok = tok_choice;
+      if( clast != NULL )
+	{
+	  clast->next = kcfg;
+	  clast = kcfg;
+	}
+      else
+	{
+	  clast = config = kcfg;
+	}
+
+      pnt = get_string(pnt, &kcfg->label);
+      pnt = skip_whitespace(pnt);
+      pnt = get_string(pnt, &kcfg->optionname);
+      kcfg->choice_label = choice_kcfg;
+      kcfg->choice_value = index++;
+      if( strcmp(kcfg->label, choice_kcfg->value) == 0 )
+	choice_kcfg->choice_value = kcfg->choice_value;
+    }
+    
+    return pnt;
+}
+
+
+/*
+ * This function grabs one text token from the input buffer
+ * and returns a pointer to a copy of just the identifier.
+ * This can be either a variable name (i.e. CONFIG_NET),
+ * or it could be the default value for the option.
+ */
+static char * get_string(char *pnt, char ** labl)
+{
+  char newlabel[1024];
+  char * pnt1;
+  char * pnt2;
+
+  if (*pnt == '\0') return pnt;
+
+  pnt1 = newlabel;
+  while(*pnt && *pnt != ' ' && *pnt != '\t')
+    {
+      *pnt1++ = *pnt++;
+    }
+  *pnt1++ = '\0';
+
+  pnt2 = (char *) malloc(strlen(newlabel) + 1);
+  strcpy(pnt2, newlabel);
+  *labl = pnt2;
+
+  if( *pnt ) pnt++;
+  return pnt;
+}
+
+
+/*
+ * Top level parse function.  Input pointer is one complete line from config.in
+ * and the result is that we create a token that describes this line
+ * and insert it into our linked list.
+ */
+void parse(char * pnt) {
+  enum token tok;
+  struct kconfig * kcfg;
+  char tmpbuf[24],fake_if[1024];
+
+  /*
+   * Ignore comments and leading whitespace.
+   */
+
+  pnt = skip_whitespace(pnt);
+  while( *pnt && (*pnt == ' ' || *pnt == '\t')) pnt++;
+  if(! *pnt ) return;
+  if( *pnt == '#' ) return;
+
+  /*
+   * Now categorize the next token.
+   */
+  tok = tok_unknown;
+  if      (strncmp(pnt, "mainmenu_name", 13) == 0) 
+    {
+      tok = tok_menuname;
+      pnt += 13;
+    }
+  else if      (strncmp(pnt, "source", 6) == 0) 
+    {
+      pnt += 7;
+      pnt = skip_whitespace(pnt);
+      do_source(pnt);
+      return;
+    }
+  else if (strncmp(pnt, "mainmenu_option", 15) == 0) 
+    {
+      menus_seen++;
+      tok = tok_menuoption;
+      pnt += 15;
+    }
+  else if (strncmp(pnt, "$MAKE ", 6) == 0) 
+    {
+      tok = tok_make;
+    }
+  else if (strncmp(pnt, "comment", 7) == 0) 
+    {
+      tok = tok_comment;
+      pnt += 7;
+    }
+  else if (strncmp(pnt, "choice", 6) == 0) 
+    {
+      tok = tok_choose;
+      pnt += 6;
+    }
+  else if (strncmp(pnt, "define_bool", 11) == 0) 
+    {
+      tok = tok_define;
+      pnt += 11;
+    }
+  else if (strncmp(pnt, "bool", 4) == 0) 
+    {
+      tok = tok_bool;
+      pnt += 4;
+    }
+  else if (strncmp(pnt, "tristate", 8) == 0) 
+    {
+      tok = tok_tristate;
+      pnt += 8;
+    }
+  else if (strncmp(pnt, "dep_tristate", 12) == 0) 
+    {
+      tok = tok_dep_tristate;
+      pnt += 12;
+    }
+  else if (strncmp(pnt, "int", 3) == 0) 
+    {
+      tok = tok_int;
+      pnt += 3;
+    }
+  else if (strncmp(pnt, "hex", 3) == 0) 
+    {
+      tok = tok_hex;
+      pnt += 3;
+    }
+  else if (strncmp(pnt, "if", 2) == 0) 
+    {
+      tok = tok_if;
+      pnt += 2;
+    }
+  else if (strncmp(pnt, "else", 4) == 0) 
+    {
+      tok = tok_else;
+      pnt += 4;
+    }
+  else if (strncmp(pnt, "fi", 2) == 0) 
+    {
+      tok = tok_fi;
+      pnt += 2;
+    }
+  else if (strncmp(pnt, "endmenu", 7) == 0) 
+    {
+      tok = tok_endmenu;
+      pnt += 7;
+    }
+
+  if( tok == tok_unknown)
+    {
+      if( clast != NULL && clast->tok == tok_if 
+	  && strcmp(pnt,"then") == 0) return;
+      if( current_file != NULL )
+	fprintf(stderr, "unknown command=%s(%s %d)\n", pnt,
+		current_file, lineno);
+      else
+	fprintf(stderr, "unknown command=%s(%d)\n", pnt,lineno);
+      return;
+    }
+
+  /*
+   * Allocate memory for this item, and attach it to the end of the linked
+   * list.
+   */
+  kcfg = (struct kconfig *) malloc(sizeof(struct kconfig));
+  memset(kcfg, 0, sizeof(struct kconfig));
+  kcfg->tok = tok;
+  if( clast != NULL )
+    {
+      clast->next = kcfg;
+      clast = kcfg;
+    }
+  else
+    {
+      clast = config = kcfg;
+    }
+
+  pnt = skip_whitespace(pnt);
+
+  /*
+   * Now parse the remaining parts of the option, and attach the results
+   * to the structure.
+   */
+  switch (tok)
+    {
+    case tok_choose:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_qstring(pnt, &kcfg->optionname);
+      pnt = get_string(pnt, &kcfg->value);
+      /*
+       * Now we need to break apart the individual options into their
+       * own configuration structures.
+       */
+      parse_choices(kcfg, kcfg->optionname);
+      free(kcfg->optionname);
+      sprintf(tmpbuf, "tmpvar_%d", choose_number++);
+      kcfg->optionname = strdup(tmpbuf);
+      break;
+    case tok_define:
+      pnt = get_string(pnt, &kcfg->optionname);
+      if(*pnt == 'y' || *pnt == 'Y' ) kcfg->value = "1";
+      if(*pnt == 'n' || *pnt == 'N' ) kcfg->value = "0";
+      if(*pnt == 'm' || *pnt == 'M' ) kcfg->value = "2";
+      break;
+    case tok_menuname:
+      pnt = get_qstring(pnt, &kcfg->label);
+      break;
+    case tok_bool:
+    case tok_tristate:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      break;
+    case tok_int:
+    case tok_hex:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      pnt = get_string(pnt, &kcfg->value);
+      break;
+    case tok_dep_tristate:
+      pnt = get_qstring(pnt, &kcfg->label);
+      pnt = get_string(pnt, &kcfg->optionname);
+      pnt = skip_whitespace(pnt);
+      if( *pnt == '$') pnt++;
+      pnt = get_string(pnt, &kcfg->depend.str);
+
+      /*
+       * Create a conditional for this object's dependency.
+       *
+       * We can't use "!= n" because this is internally converted to "!= 0"
+       * and if UMSDOS depends on MSDOS which depends on FAT, then when FAT
+       * is disabled MSDOS has 16 added to its value, making UMSDOS fully
+       * available.  Whew.
+       *
+       * This is more of a hack than a fix.  Nested "if" conditionals are
+       * probably affected too - that +/- 16 affects things in too many
+       * places.  But this should do for now.
+       */
+      sprintf(fake_if,"[ \"$%s\" = \"y\" -o \"$%s\" = \"m\" ]; then",
+	      	kcfg->depend.str,kcfg->depend.str);
+      kcfg->cond = parse_if(fake_if);
+      if(kcfg->cond == NULL )
+	{
+	  exit(1);
+	}
+      break;
+    case tok_comment:
+      pnt = get_qstring(pnt, &kcfg->label);
+      if( koption != NULL )
+	{
+	  pnt = get_qstring(pnt, &kcfg->label);
+	  koption->label = kcfg->label;
+	  koption = NULL;
+	}
+      break;
+    case tok_menuoption:
+      if( strncmp(pnt, "next_comment", 12) == 0)
+	{
+	  koption = kcfg;
+	}
+      else
+	{
+	  pnt = get_qstring(pnt, &kcfg->label);
+	}
+      break;
+    case tok_make:
+      kcfg->value=strdup(pnt);
+      break;
+    case tok_else:
+    case tok_fi:
+    case tok_endmenu:
+      break;
+    case tok_if:
+      /*
+       * Conditionals are different.  For the first level parse, only
+       * tok_if and tok_dep_tristate items have a ->cond chain attached.
+       */
+      kcfg->cond = parse_if(pnt);
+      if(kcfg->cond == NULL )
+	{
+	  exit(1);
+	}
+      break;
+    default:
+      exit(0);
+    }
+    
+    return;
+}
+
+/*
+ * Simple function to dump to the screen what the condition chain looks like.
+ */
+void dump_if(struct condition * cond)
+{
+  printf(" ");
+  while(cond != NULL )
+    {
+      switch(cond->op){
+      case op_eq:
+	printf(" = ");
+	break;
+      case op_bang:
+	printf(" ! ");
+	break;
+      case op_neq:
+	printf(" != ");
+	break;
+      case op_and:
+	printf(" -a ");
+	break;
+      case op_lparen:
+	printf("(");
+	break;
+      case op_rparen:
+	printf(")");
+	break;
+      case op_variable:
+	printf("$%s", cond->variable.str);
+	break;
+      case op_constant:
+	printf("'%s'", cond->variable.str);
+	break;
+      default:
+        break;
+      }
+      cond = cond->next;
+    }
+
+  printf("\n");
+}
+
+static int do_source(char * filename)
+{
+  char buffer[1024];
+  int  offset;
+  int old_lineno;
+  char * old_file;
+  char * pnt;
+  FILE * infile;
+
+  if( strcmp(filename, "-") == 0 )
+    infile = stdin;
+  else
+    infile = fopen(filename,"r");
+
+  /*
+   * If our cwd was in the scripts directory, we might have to go up one
+   * to find the sourced file.
+   */
+  if(!infile) {
+    strcpy (buffer, "../");
+    strcat (buffer, filename);
+    infile = fopen(buffer,"r");
+  }
+
+  if(!infile) {
+    fprintf(stderr,"Unable to open file %s\n", filename);
+    return 1;
+  }
+  old_lineno = lineno;
+  lineno = 0;
+  if( infile != stdin ) {
+    old_file = current_file;
+    current_file = filename;
+  }
+  offset = 0;
+  while(1)
+    {
+      fgets(&buffer[offset], sizeof(buffer) - offset, infile);
+      if(feof(infile)) break;
+
+      /*
+       * Strip the trailing return character.
+       */
+      pnt = buffer + strlen(buffer) - 1;
+      if( *pnt == '\n') *pnt-- = 0;
+      lineno++;
+      if( *pnt == '\\' )
+	{
+	  offset = pnt - buffer;
+	}
+      else
+	{
+	  parse(buffer);
+	  offset = 0;
+	}
+    }
+  fclose(infile);
+  if( infile != stdin ) {
+    current_file = old_file;
+  }
+  lineno = old_lineno;
+  return 0;
+}
+
+int main(int argc, char * argv[])
+{
+#if 0
+  char buffer[1024];
+  char * pnt;
+  struct kconfig * cfg;
+  int    i;
+#endif
+
+  /*
+   * Read stdin to get the top level script.
+   */
+  do_source("-");
+
+  if( menus_seen == 0 )
+    {
+      fprintf(stderr,"The config.in file for this platform does not support\n");
+      fprintf(stderr,"menus.\n");
+      exit(1);
+    }
+  /*
+   * Input file is now parsed.  Next we need to go through and attach
+   * the correct conditions to each of the actual menu items and kill
+   * the if/else/endif tokens from the list.  We also flag the menu items
+   * that have other things that depend upon its setting.
+   */
+  fix_conditionals(config);
+
+  /*
+   * Finally, we generate the wish script.
+   */
+  dump_tk_script(config);
+
+#if 0
+  /*
+   * Now dump what we have so far.  This is only for debugging so that
+   * we can display what we think we have in the list.
+   */
+  for(cfg = config; cfg; cfg = cfg->next)
+    {
+
+      if(cfg->cond != NULL && cfg->tok != tok_if)
+	dump_if(cfg->cond);
+
+      switch(cfg->tok)
+	{
+	case tok_menuname:
+	  printf("main_menuname ");
+	  break;
+	case tok_bool:
+	  printf("bool ");
+	  break;
+	case tok_tristate:
+	  printf("tristate ");
+	  break;
+	case tok_dep_tristate:
+	  printf("dep_tristate ");
+	  break;
+	case tok_int:
+	  printf("int ");
+	  break;
+	case tok_hex:
+	  printf("hex ");
+	  break;
+	case tok_comment:
+	  printf("comment ");
+	  break;
+	case tok_menuoption:
+	  printf("menuoption ");
+	  break;
+	case tok_else:
+	  printf("else");
+	  break;
+	case tok_fi:
+	  printf("fi");
+	  break;
+	case tok_if:
+	  printf("if");
+	  break;
+	default:
+	}
+
+      switch(cfg->tok)
+	{
+	case tok_menuoption:
+	case tok_comment:
+	case tok_menuname:
+	  printf("%s\n", cfg->label);
+	  break;
+	case tok_bool:
+	case tok_tristate:
+	case tok_dep_tristate:
+	case tok_int:
+	case tok_hex:
+	  printf("%s %s\n", cfg->label, cfg->optionname);
+	  break;
+	case tok_if:
+	  dump_if(cfg->cond);
+	  break;
+	case tok_nop:
+	case tok_endmenu:
+	  break;
+	default:
+	  printf("\n");
+	}
+    }
+#endif
+
+  return 0;
+
+}
Index: vendors/IOIPSL/tools/tkparse.h
===================================================================
--- vendors/IOIPSL/tools/tkparse.h	(revision 9621)
+++ vendors/IOIPSL/tools/tkparse.h	(revision 9621)
@@ -0,0 +1,82 @@
+
+enum token {
+  tok_menuname, 
+  tok_menuoption, 
+  tok_comment, 
+  tok_bool, 
+  tok_tristate, 
+  tok_dep_tristate,
+  tok_nop,
+  tok_if, 
+  tok_else, 
+  tok_fi, 
+  tok_int,
+  tok_hex,
+  tok_make,
+  tok_define,
+  tok_choose,
+  tok_choice,
+  tok_endmenu,
+  tok_unknown
+};
+
+enum operator {
+  op_eq,
+  op_neq,
+  op_and,
+  op_and1,
+  op_or,
+  op_bang,
+  op_lparen,
+  op_rparen,
+  op_variable,
+  op_kvariable,
+  op_shellcmd,
+  op_constant,
+  op_nuked
+};
+
+union var
+{
+  char * str;
+  struct kconfig * cfg;
+};
+
+struct condition
+{
+  struct condition * next;
+  enum operator op;
+  union var variable;
+};
+
+#define GLOBAL_WRITTEN  1
+#define CFG_DUP 	2
+#define UNSAFE		4
+
+struct kconfig
+{
+  struct kconfig 	* next;
+  int 			  flags;
+  enum 			  token tok;
+  char   		  menu_number;
+  char   		  menu_line;
+  char   		  submenu_start;
+  char   		  submenu_end;
+  char 			* optionname;
+  char 			* label;
+  char 			* value;
+  int   		  choice_value;
+  struct kconfig        * choice_label;
+  union var 		  depend;
+  struct condition 	* cond;
+};
+
+extern struct kconfig * config;
+extern struct kconfig * clast;
+extern struct kconfig * koption;
+
+/*
+ * Prototypes
+ */
+void fix_conditionals(struct kconfig * scfg);	/* tkcond.c */
+void dump_tk_script(struct kconfig *scfg);	/* tkgen.c  */
